/[MITgcm]/MITgcm/pkg/gmredi/gmredi_slope_psi.F
ViewVC logotype

Diff of /MITgcm/pkg/gmredi/gmredi_slope_psi.F

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

revision 1.6 by heimbach, Tue Jan 21 19:34:13 2003 UTC revision 1.7 by jmc, Sun Nov 21 15:57:17 2004 UTC
# Line 5  C $Name$ Line 5  C $Name$
5    
6  CStartOfInterface  CStartOfInterface
7        SUBROUTINE GMREDI_SLOPE_PSI(        SUBROUTINE GMREDI_SLOPE_PSI(
      I             dSigmaDrW,dSigmaDrS,  
      I             depthZ,K,  
      U             SlopeX, SlopeY,  
8       O             taperX, taperY,       O             taperX, taperY,
9         U             SlopeX, SlopeY,
10         U             dSigmaDrW,dSigmaDrS,
11         I             LrhoW, LrhoS, depthZ, K,
12       I             bi,bj, myThid )       I             bi,bj, myThid )
13  C     /==========================================================\  C     /==========================================================\
14  C     | SUBROUTINE GMREDI_SLOPE_PSI                              |  C     | SUBROUTINE GMREDI_SLOPE_PSI                              |
15  C     | o Calculate slopes for use in GM/Redi tensor             |  C     | o Calculate slopes for use in GM/Redi tensor             |
16  C     |==========================================================|  C     |==========================================================|
17  C     | On entry:                                                |  C     | On entry:                                                |
18  C     |            dSigmaDrW conatins the d/dz Sigma             |  C     |            dSigmaDrW,S  contains the d/dz Sigma          |
19  C     |            SlopeX/Y     contains X/Y gradients of sigma  |  C     |            SlopeX/Y     contains X/Y gradients of sigma  |
20  C     |            depthZ       conatins the height (m) of level |  C     |            depthZ       contains the height (m) of level |
21  C     | On exit:                                                 |  C     | On exit:                                                 |
22  C     |            dSigmaDrW conatins the effective dSig/dz      |  C     |            dSigmaDrW,S  contains the effective dSig/dz   |
23  C     |            SlopeX/Y     contains X/Y slopes              |  C     |            SlopeX/Y     contains X/Y slopes              |
24  C     |            taperFct     contains tapering funct. value ; |  C     |            taperFct     contains tapering funct. value ; |
25  C     |                         = 1 when using no tapering       |  C     |                         = 1 when using no tapering       |
# Line 39  C     == Global variables == Line 39  C     == Global variables ==
39    
40  C     == Routine arguments ==  C     == Routine arguments ==
41  C  C
42          _RL taperX(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
43          _RL taperY(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
44        _RL SlopeX(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL SlopeX(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
45        _RL SlopeY(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL SlopeY(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
46        _RL dSigmaDrW(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL dSigmaDrW(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
47        _RL dSigmaDrS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL dSigmaDrS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
48        _RL taperX(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL LrhoW(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
49        _RL taperY(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL LrhoS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
50        _RL depthZ        _RL depthZ
51        INTEGER K,bi,bj,myThid        INTEGER K,bi,bj,myThid
52  CEndOfInterface  CEndOfInterface
# Line 55  CEndOfInterface Line 57  CEndOfInterface
57  C     == Local variables ==  C     == Local variables ==
58        _RL gradSmod(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL gradSmod(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
59        _RL dSigmaDrLtd(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL dSigmaDrLtd(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
       _RL drdsigmaltd(1-Olx:sNx+Olx,1-Oly:sNy+Oly)  
60        _RL  SlopeSqr(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL  SlopeSqr(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
61        _RL f1,Smod,f2,Rnondim,Cspd,Lrho        _RL f1,Smod,f2,Rnondim
62        _RL maxSlopeSqr        _RL maxSlopeSqr
63        _RL tmpvar        _RL slopeCutoff
64        _RL fpi        _RL fpi
65        PARAMETER(fpi=3.141592653589793047592d0)        PARAMETER(fpi=3.141592653589793047592d0)
66        INTEGER i,j        INTEGER i,j
67    
68          slopeCutoff = SQRT( GM_slopeSqCutoff )
69    
70  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
71        act1 = bi - myBxLo(myThid)        act1 = bi - myBxLo(myThid)
72        max1 = myBxHi(myThid) - myBxLo(myThid) + 1        max1 = myBxHi(myThid) - myBxLo(myThid) + 1
# Line 93  C       (this turns out to be the same a Line 96  C       (this turns out to be the same a
96  C-- X-comp  C-- X-comp
97    
98  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
99        DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
100         DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
101          dSigmaDrLtd(i,j) = 0. _d 0            dSigmaDrLtd(i,j) = 0. _d 0
102         ENDDO           ENDDO
103        ENDDO          ENDDO
104  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
105    
106  C-      Cox 1987 "Slope clipping"  C-      Cox 1987 "Slope clipping"
107          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
108           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
109            dsigmadrltd(i,j) = -(GM_Small_Number+            dSigmaDrLtd(i,j) = -(GM_Small_Number+
110       &     abs(SlopeX(i,j))*GM_rMaxSlope)       &     ABS(SlopeX(i,j))*GM_rMaxSlope)
111           ENDDO           ENDDO
112          ENDDO          ENDDO
113  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
114  CADJ STORE dSigmaDrltd(:,:)  = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrLtd(:,:)  = comlev1_bibj_k, key=kkey, byte=isbyte
115  CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
116  #endif  #endif
117          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
118           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
119            IF (dSigmaDrW(i,j).GE.dsigmadrltd(i,j))            IF (dSigmaDrW(i,j).GE.dSigmaDrLtd(i,j))
120       &        dSigmaDrW(i,j) = dsigmadrltd(i,j)       &        dSigmaDrW(i,j) = dSigmaDrLtd(i,j)
121           ENDDO           ENDDO
122          ENDDO          ENDDO
123  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
124  CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
125  #endif  #endif
126          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
127           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
128            SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)            SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)
129            taperX(i,j)=1. _d 0            taperX(i,j)=1. _d 0
130           ENDDO           ENDDO
# Line 130  CADJ STORE dSigmaDrW(:,:)    = comlev1_b Line 133  CADJ STORE dSigmaDrW(:,:)    = comlev1_b
133  C-- Y-comp  C-- Y-comp
134    
135  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
136        DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly
137         DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx,sNx+Olx
138          dSigmaDrLtd(i,j) = 0. _d 0            dSigmaDrLtd(i,j) = 0. _d 0
139         ENDDO           ENDDO
140        ENDDO          ENDDO
141  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
142          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly
143           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx,sNx+Olx
144            dsigmadrltd(i,j) = -(GM_Small_Number+            dSigmaDrLtd(i,j) = -(GM_Small_Number+
145       &     abs(SlopeY(i,j))*GM_rMaxSlope)       &     ABS(SlopeY(i,j))*GM_rMaxSlope)
146           ENDDO           ENDDO
147          ENDDO          ENDDO
148  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
149  CADJ STORE dSigmaDrltd(:,:)  = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrLtd(:,:)  = comlev1_bibj_k, key=kkey, byte=isbyte
150  CADJ STORE dSigmaDrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
151  #endif  #endif
152          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly
153           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx,sNx+Olx
154            IF (dSigmaDrS(i,j).GE.dsigmadrltd(i,j))            IF (dSigmaDrS(i,j).GE.dSigmaDrLtd(i,j))
155       &        dSigmaDrS(i,j) = dsigmadrltd(i,j)       &        dSigmaDrS(i,j) = dSigmaDrLtd(i,j)
156           ENDDO           ENDDO
157          ENDDO          ENDDO
158  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
159  CADJ STORE dSigmaDrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
160  #endif  #endif
161          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly
162           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx,sNx+Olx
163            SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)            SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)
164            taperY(i,j)=1. _d 0            taperY(i,j)=1. _d 0
165           ENDDO           ENDDO
# Line 177  CADJ STORE slopeX(:,:)       = comlev1_b Line 180  CADJ STORE slopeX(:,:)       = comlev1_b
180  CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
181  #endif  #endif
182    
         tmpvar = sqrt( GM_slopeSqCutoff )  
   
183  C- Compute the slope, no clipping, but avoid reverse slope in negatively  C- Compute the slope, no clipping, but avoid reverse slope in negatively
184  C                                  stratified (Sigma_Z > 0) region :  C                                  stratified (Sigma_Z > 0) region :
185          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
186           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
187            dsigmadrltd(i,j) = -GM_Small_Number            IF (dSigmaDrW(i,j).GE.-GM_Small_Number)
188            IF (dSigmaDrW(i,j).GE.dsigmadrltd(i,j))       &        dSigmaDrW(i,j) = -GM_Small_Number
      &        dSigmaDrW(i,j) = dsigmadrltd(i,j)  
189           ENDDO           ENDDO
190          ENDDO          ENDDO
191  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
192  CADJ STORE dsigmadrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dsigmadrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
193  #endif  #endif
194          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
195           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
           drdsigmaltd(i,j) = 1./dSigmaDrW(i,j)  
196            SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)            SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)
197            taperX(i,j)= 1. _d 0            taperX(i,j)= 1. _d 0
198           ENDDO           ENDDO
# Line 201  CADJ STORE dsigmadrW(:,:)    = comlev1_b Line 200  CADJ STORE dsigmadrW(:,:)    = comlev1_b
200  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
201  CADJ STORE slopex(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE slopex(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
202  #endif  #endif
203          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
204           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
205            IF ( ABS(SlopeX(i,j)) .GE. tmpvar ) THEN            IF ( ABS(SlopeX(i,j)) .GE. slopeCutoff ) THEN
206               SlopeX(i,j) = SIGN(tmpvar,SlopeX(i,j))               SlopeX(i,j) = SIGN(slopeCutoff,SlopeX(i,j))
207               taperX(i,j) = 0. _d 0               taperX(i,j) = 0. _d 0
208            ENDIF            ENDIF
209           ENDDO           ENDDO
# Line 215  CADJ STORE slopeY(:,:)       = comlev1_b Line 214  CADJ STORE slopeY(:,:)       = comlev1_b
214  CADJ STORE dSigmaDrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
215  #endif  #endif
216    
217          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly
218           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx,sNx+Olx
219            dsigmadrltd(i,j) = -GM_Small_Number            IF (dSigmaDrS(i,j).GE.-GM_Small_Number)
220            IF (dSigmaDrS(i,j).GE.dsigmadrltd(i,j))       &        dSigmaDrS(i,j) = -GM_Small_Number
      &        dSigmaDrS(i,j) = dsigmadrltd(i,j)  
221           ENDDO           ENDDO
222          ENDDO          ENDDO
223  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
224  CADJ STORE dsigmadrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dsigmadrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
225  #endif  #endif
226          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly
227           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx,sNx+Olx
228            SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)            SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)
229            taperY(i,j)=1. _d 0            taperY(i,j)=1. _d 0
230           ENDDO           ENDDO
# Line 234  CADJ STORE dsigmadrS(:,:)    = comlev1_b Line 232  CADJ STORE dsigmadrS(:,:)    = comlev1_b
232  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
233  CADJ STORE slopey(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE slopey(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
234  #endif  #endif
235          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly
236           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx,sNx+Olx
237            IF ( ABS(SlopeY(i,j)) .GE. tmpvar ) THEN            IF ( ABS(SlopeY(i,j)) .GE. slopeCutoff ) THEN
238               SlopeY(i,j) = SIGN(tmpvar,SlopeY(i,j))               SlopeY(i,j) = SIGN(slopeCutoff,SlopeY(i,j))
239               taperY(i,j) = 0. _d 0               taperY(i,j) = 0. _d 0
240            ENDIF            ENDIF
241           ENDDO           ENDDO
# Line 253  CADJ STORE slopeY(:,:)       = comlev1_b Line 251  CADJ STORE slopeY(:,:)       = comlev1_b
251         IF (GM_taper_scheme.EQ.'linear') THEN         IF (GM_taper_scheme.EQ.'linear') THEN
252    
253  C-      Simplest adiabatic tapering = Smax/Slope (linear)  C-      Simplest adiabatic tapering = Smax/Slope (linear)
254          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
255           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
256              Smod = ABS(SlopeX(i,j))
           Smod = abs(SlopeX(i,j))  
257            IF ( Smod .GT. GM_maxSlope .AND.            IF ( Smod .GT. GM_maxSlope .AND.
258       &           Smod .LT. tmpvar )       &           Smod .LT. slopeCutoff )
259       &           taperX(i,j)=GM_maxSlope/(Smod+GM_Small_Number)       &           taperX(i,j)=GM_maxSlope/(Smod+GM_Small_Number)
260            Smod = abs(SlopeY(i,j))           ENDDO
261            ENDDO
262            DO j=1-Oly+1,sNy+Oly
263             DO i=1-Olx,sNx+Olx
264              Smod = ABS(SlopeY(i,j))
265            IF ( Smod .GT. GM_maxSlope .AND.            IF ( Smod .GT. GM_maxSlope .AND.
266       &           Smod .LT. tmpvar )       &           Smod .LT. slopeCutoff )
267       &           taperY(i,j)=GM_maxSlope/(Smod+GM_Small_Number)       &           taperY(i,j)=GM_maxSlope/(Smod+GM_Small_Number)
   
268           ENDDO           ENDDO
269          ENDDO          ENDDO
270    
271         ELSEIF (GM_taper_scheme.EQ.'gkw91') THEN         ELSEIF (GM_taper_scheme.EQ.'gkw91') THEN
272    
273  C-      Gerdes, Koberle and Willebrand, Clim. Dyn. 1991  C-      Gerdes, Koberle and Willebrand, Clim. Dyn. 1991
   
274          maxSlopeSqr = GM_maxSlope*GM_maxSlope          maxSlopeSqr = GM_maxSlope*GM_maxSlope
275          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
276           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
277              IF ( ABS(SlopeX(i,j)) .GT. GM_maxSlope .AND.
278            IF ( abs(SlopeX(i,j)) .GT. GM_maxSlope .AND.       &           ABS(SlopeX(i,j)) .LT. slopeCutoff )
      &           abs(SlopeX(i,j)) .LT. tmpvar )  
279       &           taperX(i,j)=maxSlopeSqr/       &           taperX(i,j)=maxSlopeSqr/
280       &           ( SlopeX(i,j)*SlopeX(i,j) + GM_Small_Number )       &           ( SlopeX(i,j)*SlopeX(i,j) + GM_Small_Number )
281            IF ( abs(SlopeY(i,j)) .GT. GM_maxSlope .AND.           ENDDO
282       &           abs(SlopeY(i,j)) .LT. tmpvar )          ENDDO
283            DO j=1-Oly+1,sNy+Oly
284             DO i=1-Olx,sNx+Olx
285              IF ( ABS(SlopeY(i,j)) .GT. GM_maxSlope .AND.
286         &           ABS(SlopeY(i,j)) .LT. slopeCutoff )
287       &           taperY(i,j)=maxSlopeSqr/       &           taperY(i,j)=maxSlopeSqr/
288       &           ( SlopeY(i,j)*SlopeY(i,j) + GM_Small_Number )       &           ( SlopeY(i,j)*SlopeY(i,j) + GM_Small_Number )
   
289           ENDDO           ENDDO
290          ENDDO          ENDDO
291    
292         ELSEIF (GM_taper_scheme.EQ.'dm95') THEN         ELSEIF (GM_taper_scheme.EQ.'dm95') THEN
293    
294  C-      Danabasoglu and McWilliams, J. Clim. 1995  C-      Danabasoglu and McWilliams, J. Clim. 1995
295          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
296           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
297              Smod = ABS(SlopeX(i,j))
298            Smod = abs(SlopeX(i,j))            taperX(i,j)=op5*( 1. _d 0 + TANH( (GM_Scrit-Smod)/GM_Sd ))
299            taperX(i,j)=op5*( 1. _d 0 + tanh( (GM_Scrit-Smod)/GM_Sd ))           ENDDO
300            Smod = abs(SlopeY(i,j))          ENDDO
301            taperY(i,j)=op5*( 1. _d 0 + tanh( (GM_Scrit-Smod)/GM_Sd ))          DO j=1-Oly+1,sNy+Oly
302             DO i=1-Olx,sNx+Olx
303              Smod = ABS(SlopeY(i,j))
304              taperY(i,j)=op5*( 1. _d 0 + TANH( (GM_Scrit-Smod)/GM_Sd ))
305           ENDDO           ENDDO
306          ENDDO          ENDDO
307    
308         ELSEIF (GM_taper_scheme.EQ.'ldd97') THEN         ELSEIF (GM_taper_scheme.EQ.'ldd97') THEN
309    
310  C-      Large, Danabasoglu and Doney, JPO 1997  C-      Large, Danabasoglu and Doney, JPO 1997
         DO j=1-Oly+1,sNy+Oly-1  
          DO i=1-Olx+1,sNx+Olx-1  
311    
312            Cspd=2. _d 0          DO j=1-Oly,sNy+Oly
313            Lrho=100. _d 3           DO i=1-Olx+1,sNx+Olx
314            if (fCori(i,j,bi,bj).NE.0.) Lrho=Cspd/abs(fCori(i,j,bi,bj))            Smod = ABS(SlopeX(i,j))
315            Lrho=min(Lrho , 100. _d 3)            IF ( Smod .LT. slopeCutoff ) THEN
316            Lrho=max(Lrho , 15. _d 3)            f1=op5*( 1. _d 0 + TANH( (GM_Scrit-Smod)/GM_Sd ))
317              IF (Smod.NE.0.) THEN
318            Smod = abs(SlopeX(i,j))              Rnondim=depthZ/(LrhoW(i,j)*Smod)
319            if ( Smod .LT. tmpvar ) then            ELSE
           f1=op5*( 1. _d 0 + tanh( (GM_Scrit-Smod)/GM_Sd ))  
           if (Smod.NE.0.) then  
             Rnondim=depthZ/(Lrho*Smod)  
           else  
320              Rnondim=0.              Rnondim=0.
321            endif            ENDIF
322            f2=op5*( 1. _d 0 + sin( fpi*(Rnondim-op5)))            f2=op5*( 1. _d 0 + SIN( fpi*(Rnondim-op5)))
323            taperX(i,j)=f1*f2            taperX(i,j)=f1*f2
324            endif            ENDIF
325             ENDDO
326            ENDDO
327    
328            Smod = abs(SlopeY(i,j))          DO j=1-Oly+1,sNy+Oly
329            if ( Smod .LT. tmpvar ) then           DO i=1-Olx,sNx+Olx
330            f1=op5*( 1. _d 0 + tanh( (GM_Scrit-Smod)/GM_Sd ))            Smod = ABS(SlopeY(i,j))
331            if (Smod.NE.0.) then            IF ( Smod .LT. slopeCutoff ) THEN
332              Rnondim=depthZ/(Lrho*Smod)            f1=op5*( 1. _d 0 + TANH( (GM_Scrit-Smod)/GM_Sd ))
333            else            IF (Smod.NE.0.) THEN
334                Rnondim=depthZ/(LrhoS(i,j)*Smod)
335              ELSE
336              Rnondim=0.              Rnondim=0.
337            endif            ENDIF
338            f2=op5*( 1. _d 0 + sin( fpi*(Rnondim-op5)))            f2=op5*( 1. _d 0 + SIN( fpi*(Rnondim-op5)))
339            taperY(i,j)=f1*f2            taperY(i,j)=f1*f2
340            endif            ENDIF
   
341           ENDDO           ENDDO
342          ENDDO          ENDDO
343    
# Line 349  C-      Large, Danabasoglu and Doney, JP Line 349  C-      Large, Danabasoglu and Doney, JP
349    
350        ENDIF        ENDIF
351    
   
352  #endif /* BOLUS_ADVEC */  #endif /* BOLUS_ADVEC */
353  #endif /* ALLOW_GMREDI */  #endif /* ALLOW_GMREDI */
354    
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22