/[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.9 by jmc, Thu Dec 8 21:40:16 2005 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 depth (< 0 !) [m]   |
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        _RS depthZ
51        INTEGER K,bi,bj,myThid        INTEGER K,bi,bj,myThid
52  CEndOfInterface  CEndOfInterface
53    
# Line 53  CEndOfInterface Line 55  CEndOfInterface
55  #ifdef GM_BOLUS_ADVEC  #ifdef GM_BOLUS_ADVEC
56    
57  C     == Local variables ==  C     == Local variables ==
       _RL gradSmod(1-Olx:sNx+Olx,1-Oly:sNy+Oly)  
58        _RL dSigmaDrLtd(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL dSigmaDrLtd(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
59        _RL drdsigmaltd(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL f1,Smod,f2,Rnondim
       _RL  SlopeSqr(1-Olx:sNx+Olx,1-Oly:sNy+Oly)  
       _RL f1,Smod,f2,Rnondim,Cspd,Lrho  
60        _RL maxSlopeSqr        _RL maxSlopeSqr
61        _RL tmpvar        _RL slopeCutoff
62        _RL fpi        _RL fpi
63        PARAMETER(fpi=3.141592653589793047592d0)        PARAMETER(fpi=3.141592653589793047592d0)
64        INTEGER i,j        INTEGER i,j
65    
66          slopeCutoff = SQRT( GM_slopeSqCutoff )
67    
68  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
69        act1 = bi - myBxLo(myThid)        act1 = bi - myBxLo(myThid)
70        max1 = myBxHi(myThid) - myBxLo(myThid) + 1        max1 = myBxHi(myThid) - myBxLo(myThid) + 1
# Line 93  C       (this turns out to be the same a Line 94  C       (this turns out to be the same a
94  C-- X-comp  C-- X-comp
95    
96  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
97        DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
98         DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
99          dSigmaDrLtd(i,j) = 0. _d 0            dSigmaDrLtd(i,j) = 0. _d 0
100         ENDDO           ENDDO
101        ENDDO          ENDDO
102  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
103    
104  C-      Cox 1987 "Slope clipping"  C-      Cox 1987 "Slope clipping"
105          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
106           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
107            dsigmadrltd(i,j) = -(GM_Small_Number+            dSigmaDrLtd(i,j) = -(GM_Small_Number+
108       &     abs(SlopeX(i,j))*GM_rMaxSlope)       &     ABS(SlopeX(i,j))*GM_rMaxSlope)
109           ENDDO           ENDDO
110          ENDDO          ENDDO
111  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
112  CADJ STORE dSigmaDrltd(:,:)  = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrLtd(:,:)  = comlev1_bibj_k, key=kkey, byte=isbyte
113  CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
114  #endif  #endif
115          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
116           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
117            IF (dSigmaDrW(i,j).GE.dsigmadrltd(i,j))            IF (dSigmaDrW(i,j).GE.dSigmaDrLtd(i,j))
118       &        dSigmaDrW(i,j) = dsigmadrltd(i,j)       &        dSigmaDrW(i,j) = dSigmaDrLtd(i,j)
119           ENDDO           ENDDO
120          ENDDO          ENDDO
121  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
122  CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
123  #endif  #endif
124          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
125           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
126            SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)            SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)
127            taperX(i,j)=1. _d 0            taperX(i,j) = 1. _d 0
128           ENDDO           ENDDO
129          ENDDO          ENDDO
130    
131  C-- Y-comp  C-- Y-comp
132    
133  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
134        DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly
135         DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx,sNx+Olx
136          dSigmaDrLtd(i,j) = 0. _d 0            dSigmaDrLtd(i,j) = 0. _d 0
137         ENDDO           ENDDO
138        ENDDO          ENDDO
139  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
140          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly
141           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx,sNx+Olx
142            dsigmadrltd(i,j) = -(GM_Small_Number+            dSigmaDrLtd(i,j) = -(GM_Small_Number+
143       &     abs(SlopeY(i,j))*GM_rMaxSlope)       &     ABS(SlopeY(i,j))*GM_rMaxSlope)
144           ENDDO           ENDDO
145          ENDDO          ENDDO
146  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
147  CADJ STORE dSigmaDrltd(:,:)  = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrLtd(:,:)  = comlev1_bibj_k, key=kkey, byte=isbyte
148  CADJ STORE dSigmaDrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
149  #endif  #endif
150          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly
151           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx,sNx+Olx
152            IF (dSigmaDrS(i,j).GE.dsigmadrltd(i,j))            IF (dSigmaDrS(i,j).GE.dSigmaDrLtd(i,j))
153       &        dSigmaDrS(i,j) = dsigmadrltd(i,j)       &        dSigmaDrS(i,j) = dSigmaDrLtd(i,j)
154           ENDDO           ENDDO
155          ENDDO          ENDDO
156  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
157  CADJ STORE dSigmaDrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
158  #endif  #endif
159          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly
160           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx,sNx+Olx
161            SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)            SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)
162            taperY(i,j)=1. _d 0            taperY(i,j) = 1. _d 0
163           ENDDO           ENDDO
164          ENDDO          ENDDO
165    
# Line 177  CADJ STORE slopeX(:,:)       = comlev1_b Line 178  CADJ STORE slopeX(:,:)       = comlev1_b
178  CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
179  #endif  #endif
180    
         tmpvar = sqrt( GM_slopeSqCutoff )  
   
181  C- Compute the slope, no clipping, but avoid reverse slope in negatively  C- Compute the slope, no clipping, but avoid reverse slope in negatively
182  C                                  stratified (Sigma_Z > 0) region :  C                                  stratified (Sigma_Z > 0) region :
183          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
184           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
185            dsigmadrltd(i,j) = -GM_Small_Number            IF (dSigmaDrW(i,j).GE.-GM_Small_Number)
186            IF (dSigmaDrW(i,j).GE.dsigmadrltd(i,j))       &        dSigmaDrW(i,j) = -GM_Small_Number
      &        dSigmaDrW(i,j) = dsigmadrltd(i,j)  
187           ENDDO           ENDDO
188          ENDDO          ENDDO
189  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
190  CADJ STORE dsigmadrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dsigmadrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
191  #endif  #endif
192          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
193           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
           drdsigmaltd(i,j) = 1./dSigmaDrW(i,j)  
194            SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)            SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)
195            taperX(i,j)= 1. _d 0            taperX(i,j) = 1. _d 0
196           ENDDO           ENDDO
197          ENDDO          ENDDO
198  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
199  CADJ STORE slopex(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE slopex(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
200  #endif  #endif
201          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
202           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
203            IF ( ABS(SlopeX(i,j)) .GE. tmpvar ) THEN            IF ( ABS(SlopeX(i,j)) .GE. slopeCutoff ) THEN
204               SlopeX(i,j) = SIGN(tmpvar,SlopeX(i,j))               SlopeX(i,j) = SIGN(slopeCutoff,SlopeX(i,j))
205               taperX(i,j) = 0. _d 0               taperX(i,j) = 0. _d 0
206            ENDIF            ENDIF
207           ENDDO           ENDDO
# Line 215  CADJ STORE slopeY(:,:)       = comlev1_b Line 212  CADJ STORE slopeY(:,:)       = comlev1_b
212  CADJ STORE dSigmaDrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
213  #endif  #endif
214    
215          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly
216           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx,sNx+Olx
217            dsigmadrltd(i,j) = -GM_Small_Number            IF (dSigmaDrS(i,j).GE.-GM_Small_Number)
218            IF (dSigmaDrS(i,j).GE.dsigmadrltd(i,j))       &        dSigmaDrS(i,j) = -GM_Small_Number
      &        dSigmaDrS(i,j) = dsigmadrltd(i,j)  
219           ENDDO           ENDDO
220          ENDDO          ENDDO
221  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
222  CADJ STORE dsigmadrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dsigmadrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
223  #endif  #endif
224          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly
225           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx,sNx+Olx
226            SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)            SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)
227            taperY(i,j)=1. _d 0            taperY(i,j) = 1. _d 0
228           ENDDO           ENDDO
229          ENDDO          ENDDO
230  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
231  CADJ STORE slopey(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE slopey(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
232  #endif  #endif
233          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly
234           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx,sNx+Olx
235            IF ( ABS(SlopeY(i,j)) .GE. tmpvar ) THEN            IF ( ABS(SlopeY(i,j)) .GE. slopeCutoff ) THEN
236               SlopeY(i,j) = SIGN(tmpvar,SlopeY(i,j))               SlopeY(i,j) = SIGN(slopeCutoff,SlopeY(i,j))
237               taperY(i,j) = 0. _d 0               taperY(i,j) = 0. _d 0
238            ENDIF            ENDIF
239           ENDDO           ENDDO
# Line 253  CADJ STORE slopeY(:,:)       = comlev1_b Line 249  CADJ STORE slopeY(:,:)       = comlev1_b
249         IF (GM_taper_scheme.EQ.'linear') THEN         IF (GM_taper_scheme.EQ.'linear') THEN
250    
251  C-      Simplest adiabatic tapering = Smax/Slope (linear)  C-      Simplest adiabatic tapering = Smax/Slope (linear)
252          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
253           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
254              Smod = ABS(SlopeX(i,j))
           Smod = abs(SlopeX(i,j))  
255            IF ( Smod .GT. GM_maxSlope .AND.            IF ( Smod .GT. GM_maxSlope .AND.
256       &           Smod .LT. tmpvar )       &           Smod .LT. slopeCutoff )
257       &           taperX(i,j)=GM_maxSlope/(Smod+GM_Small_Number)       &           taperX(i,j)=GM_maxSlope/(Smod+GM_Small_Number)
258            Smod = abs(SlopeY(i,j))           ENDDO
259            ENDDO
260            DO j=1-Oly+1,sNy+Oly
261             DO i=1-Olx,sNx+Olx
262              Smod = ABS(SlopeY(i,j))
263            IF ( Smod .GT. GM_maxSlope .AND.            IF ( Smod .GT. GM_maxSlope .AND.
264       &           Smod .LT. tmpvar )       &           Smod .LT. slopeCutoff )
265       &           taperY(i,j)=GM_maxSlope/(Smod+GM_Small_Number)       &           taperY(i,j)=GM_maxSlope/(Smod+GM_Small_Number)
   
266           ENDDO           ENDDO
267          ENDDO          ENDDO
268    
269         ELSEIF (GM_taper_scheme.EQ.'gkw91') THEN         ELSEIF (GM_taper_scheme.EQ.'gkw91') THEN
270    
271  C-      Gerdes, Koberle and Willebrand, Clim. Dyn. 1991  C-      Gerdes, Koberle and Willebrand, Clim. Dyn. 1991
   
272          maxSlopeSqr = GM_maxSlope*GM_maxSlope          maxSlopeSqr = GM_maxSlope*GM_maxSlope
273          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
274           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
275              IF ( ABS(SlopeX(i,j)) .GT. GM_maxSlope .AND.
276            IF ( abs(SlopeX(i,j)) .GT. GM_maxSlope .AND.       &           ABS(SlopeX(i,j)) .LT. slopeCutoff )
      &           abs(SlopeX(i,j)) .LT. tmpvar )  
277       &           taperX(i,j)=maxSlopeSqr/       &           taperX(i,j)=maxSlopeSqr/
278       &           ( SlopeX(i,j)*SlopeX(i,j) + GM_Small_Number )       &           ( SlopeX(i,j)*SlopeX(i,j) + GM_Small_Number )
279            IF ( abs(SlopeY(i,j)) .GT. GM_maxSlope .AND.           ENDDO
280       &           abs(SlopeY(i,j)) .LT. tmpvar )          ENDDO
281            DO j=1-Oly+1,sNy+Oly
282             DO i=1-Olx,sNx+Olx
283              IF ( ABS(SlopeY(i,j)) .GT. GM_maxSlope .AND.
284         &           ABS(SlopeY(i,j)) .LT. slopeCutoff )
285       &           taperY(i,j)=maxSlopeSqr/       &           taperY(i,j)=maxSlopeSqr/
286       &           ( SlopeY(i,j)*SlopeY(i,j) + GM_Small_Number )       &           ( SlopeY(i,j)*SlopeY(i,j) + GM_Small_Number )
   
287           ENDDO           ENDDO
288          ENDDO          ENDDO
289    
290         ELSEIF (GM_taper_scheme.EQ.'dm95') THEN         ELSEIF (GM_taper_scheme.EQ.'dm95') THEN
291    
292  C-      Danabasoglu and McWilliams, J. Clim. 1995  C-      Danabasoglu and McWilliams, J. Clim. 1995
293          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly,sNy+Oly
294           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx
295              Smod = ABS(SlopeX(i,j))
296            Smod = abs(SlopeX(i,j))            taperX(i,j)=op5*( 1. _d 0 + TANH( (GM_Scrit-Smod)/GM_Sd ))
297            taperX(i,j)=op5*( 1. _d 0 + tanh( (GM_Scrit-Smod)/GM_Sd ))           ENDDO
298            Smod = abs(SlopeY(i,j))          ENDDO
299            taperY(i,j)=op5*( 1. _d 0 + tanh( (GM_Scrit-Smod)/GM_Sd ))          DO j=1-Oly+1,sNy+Oly
300             DO i=1-Olx,sNx+Olx
301              Smod = ABS(SlopeY(i,j))
302              taperY(i,j)=op5*( 1. _d 0 + TANH( (GM_Scrit-Smod)/GM_Sd ))
303           ENDDO           ENDDO
304          ENDDO          ENDDO
305    
306         ELSEIF (GM_taper_scheme.EQ.'ldd97') THEN         ELSEIF (GM_taper_scheme.EQ.'ldd97') THEN
307    
308  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  
309    
310            Cspd=2. _d 0          DO j=1-Oly,sNy+Oly
311            Lrho=100. _d 3           DO i=1-Olx+1,sNx+Olx
312            if (fCori(i,j,bi,bj).NE.0.) Lrho=Cspd/abs(fCori(i,j,bi,bj))            Smod = ABS(SlopeX(i,j))
313            Lrho=min(Lrho , 100. _d 3)            IF ( Smod .LT. slopeCutoff ) THEN
314            Lrho=max(Lrho , 15. _d 3)              f1=op5*( 1. _d 0 + TANH( (GM_Scrit-Smod)/GM_Sd ))
315                IF (Smod.NE.0.) THEN
316            Smod = abs(SlopeX(i,j))                Rnondim = -depthZ/(LrhoW(i,j)*Smod)
317            if ( Smod .LT. tmpvar ) then              ELSE
318            f1=op5*( 1. _d 0 + tanh( (GM_Scrit-Smod)/GM_Sd ))                Rnondim = 1.
319            if (Smod.NE.0.) then              ENDIF
320              Rnondim=depthZ/(Lrho*Smod)              IF ( Rnondim.GE.1. _d 0 ) THEN
321            else                f2 = 1. _d 0
322              Rnondim=0.              ELSE
323            endif                f2 = op5*( 1. _d 0 + SIN( fpi*(Rnondim-op5) ))
324            f2=op5*( 1. _d 0 + sin( fpi*(Rnondim-op5)))              ENDIF
325            taperX(i,j)=f1*f2              taperX(i,j)=f1*f2
326            endif            ENDIF
327             ENDDO
328            Smod = abs(SlopeY(i,j))          ENDDO
           if ( Smod .LT. tmpvar ) then  
           f1=op5*( 1. _d 0 + tanh( (GM_Scrit-Smod)/GM_Sd ))  
           if (Smod.NE.0.) then  
             Rnondim=depthZ/(Lrho*Smod)  
           else  
             Rnondim=0.  
           endif  
           f2=op5*( 1. _d 0 + sin( fpi*(Rnondim-op5)))  
           taperY(i,j)=f1*f2  
           endif  
329    
330            DO j=1-Oly+1,sNy+Oly
331             DO i=1-Olx,sNx+Olx
332              Smod = ABS(SlopeY(i,j))
333              IF ( Smod .LT. slopeCutoff ) THEN
334                f1=op5*( 1. _d 0 + TANH( (GM_Scrit-Smod)/GM_Sd ))
335                IF (Smod.NE.0.) THEN
336                  Rnondim = -depthZ/(LrhoS(i,j)*Smod)
337                ELSE
338                  Rnondim = 1.
339                ENDIF
340                IF ( Rnondim.GE.1. _d 0 ) THEN
341                  f2 = 1. _d 0
342                ELSE
343                  f2 = op5*( 1. _d 0 + SIN( fpi*(Rnondim-op5) ))
344                ENDIF
345                taperY(i,j)=f1*f2
346              ENDIF
347           ENDDO           ENDDO
348          ENDDO          ENDDO
349    
# Line 349  C-      Large, Danabasoglu and Doney, JP Line 355  C-      Large, Danabasoglu and Doney, JP
355    
356        ENDIF        ENDIF
357    
   
358  #endif /* BOLUS_ADVEC */  #endif /* BOLUS_ADVEC */
359  #endif /* ALLOW_GMREDI */  #endif /* ALLOW_GMREDI */
360    
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22