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

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

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

revision 1.17 by jmc, Sun Jan 12 21:35:27 2003 UTC revision 1.18 by jmc, Mon Jan 13 19:02:45 2003 UTC
# Line 55  CEndOfInterface Line 55  CEndOfInterface
55  #ifdef ALLOW_GMREDI  #ifdef ALLOW_GMREDI
56    
57  C     == Local variables ==  C     == Local variables ==
       _RL Small_Number  
58        _RL Small_Taper        _RL Small_Taper
       _RL Large_SlopeSqr  
       PARAMETER(Small_Number=1.D-12)  
59        PARAMETER(Small_Taper=1.D+03)        PARAMETER(Small_Taper=1.D+03)
       PARAMETER(Large_SlopeSqr=1.D+48)  
60    
61        _RL gradSmod(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL gradSmod(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
62        _RL dSigmaDrLtd(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL dSigmaDrLtd(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
# Line 71  C     == Local variables == Line 67  C     == Local variables ==
67        _RL fpi        _RL fpi
68        PARAMETER(fpi=3.141592653589793047592d0)        PARAMETER(fpi=3.141592653589793047592d0)
69        INTEGER i,j        INTEGER i,j
 c     Small_Number=GM_Small_Number  
70    
71  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
72        act1 = bi - myBxLo(myThid)        act1 = bi - myBxLo(myThid)
# Line 97  c     Small_Number=GM_Small_Number Line 92  c     Small_Number=GM_Small_Number
92        IF (GM_taper_scheme.EQ.'orig' .OR.        IF (GM_taper_scheme.EQ.'orig' .OR.
93       &    GM_taper_scheme.EQ.'clipping') THEN       &    GM_taper_scheme.EQ.'clipping') THEN
94    
95  #ifdef GM_TAPER_ORIG_CLIPPING  #ifdef GM_EXCLUDE_CLIPPING
96    
97            STOP 'Need to compile without "#define GM_EXCLUDE_CLIPPING"'
98    
99    #else  /* GM_EXCLUDE_CLIPPING */
100    
101  C-      Original implementation in mitgcmuv  C-      Original implementation in mitgcmuv
102  C       (this turns out to be the same as Cox slope clipping)  C       (this turns out to be the same as Cox slope clipping)
# Line 162  cnostore CADJ STORE slopeY(:,:)       = Line 161  cnostore CADJ STORE slopeY(:,:)       =
161           ENDDO           ENDDO
162          ENDDO          ENDDO
163    
164  #else /* GM_TAPER_ORIG_CLIPPING */  #endif /* GM_EXCLUDE_CLIPPING */
165    
166          STOP 'Need to compile with "#define GM_TAPER_ORIG_CLIPPING"'        ELSE IF (GM_taper_scheme.EQ.'ac02') THEN
167    
168  #endif /* GM_TAPER_ORIG_CLIPPING */  #ifdef GM_EXCLUDE_AC02_TAP
169    
170        ELSE IF (GM_taper_scheme.EQ.'ac02') THEN          STOP 'Need to compile without "#define GM_EXCLUDE_AC02_TAP"'
171    
172    #else  /* GM_EXCLUDE_AC02_TAP */
173    
174  #ifdef GM_TAPER_AC02  C-      New Scheme (A. & C. 2002): relax part of the small slope approximation
175    C         compute the true slope (no approximation)
176    C         but still neglect Kxy & Kyx (assumed to be zero)
177    
178          maxSlopeSqr = GM_maxSlope*GM_maxSlope          maxSlopeSqr = GM_maxSlope*GM_maxSlope
179          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
# Line 194  cph             T11(i,j)=(dSigmaDrReal(i Line 197  cph             T11(i,j)=(dSigmaDrReal(i
197            ENDIF            ENDIF
198  cph-- this part doesn't adjoint well  cph-- this part doesn't adjoint well
199  cph          IF ( SlopeSqr(i,j) .GT. maxSlopeSqr .AND.  cph          IF ( SlopeSqr(i,j) .GT. maxSlopeSqr .AND.
200  cph     &         SlopeSqr(i,j) .LT. Large_SlopeSqr ) THEN  cph     &         SlopeSqr(i,j) .LT. GM_slopeSqCutoff ) THEN
201  cph           taperFct(i,j) = maxSlopeSqr/SlopeSqr(i,j)  cph           taperFct(i,j) = maxSlopeSqr/SlopeSqr(i,j)
202  cph          ELSE IF ( SlopeSqr(i,j) .GT. Large_SlopeSqr ) THEN  cph          ELSE IF ( SlopeSqr(i,j) .GT. GM_slopeSqCutoff ) THEN
203  cph           taperFct(i,j) = 0. _d 0  cph           taperFct(i,j) = 0. _d 0
204  cph          ENDIF  cph          ENDIF
205           ENDDO           ENDDO
206          ENDDO          ENDDO
207    
208  #else /* GM_TAPER_AC02 */  #endif /* GM_EXCLUDE_AC02_TAP */
         
         STOP 'Need to compile with "#define GM_TAPER_AC02"'  
   
 #endif /* GM_TAPER_AC02 */  
209    
210        ELSE        ELSE
211    
212  #ifdef GM_TAPER_REST  #ifdef GM_EXCLUDE_TAPERING
213    
214            STOP 'Need to compile without "#define GM_EXCLUDE_TAPERING"'
215    
216    #else  /* GM_EXCLUDE_TAPERING */
217    
218  C----------------------------------------------------------------------  C----------------------------------------------------------------------
219    
# Line 224  cnostore CADJ STORE dSigmaDrReal(:,:) = Line 227  cnostore CADJ STORE dSigmaDrReal(:,:) =
227          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
228           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
229            IF ( dSigmaDrReal(i,j) .NE. 0. ) THEN            IF ( dSigmaDrReal(i,j) .NE. 0. ) THEN
230             IF (dSigmaDrReal(i,j).GE.(-Small_Number))             IF (dSigmaDrReal(i,j).GE.(-GM_Small_Number))
231       &         dSigmaDrReal(i,j) = -Small_Number       &         dSigmaDrReal(i,j) = -GM_Small_Number
232            ENDIF            ENDIF
233           ENDDO           ENDDO
234          ENDDO          ENDDO
# Line 269  cnostore CADJ STORE slopeY(:,:)       = Line 272  cnostore CADJ STORE slopeY(:,:)       =
272            SlopeSqr(i,j) = SlopeX(i,j)*SlopeX(i,j)            SlopeSqr(i,j) = SlopeX(i,j)*SlopeX(i,j)
273       &                   +SlopeY(i,j)*SlopeY(i,j)       &                   +SlopeY(i,j)*SlopeY(i,j)
274            taperFct(i,j) = 1. _d 0            taperFct(i,j) = 1. _d 0
275            IF ( SlopeSqr(i,j) .GT. Large_SlopeSqr ) THEN            IF ( SlopeSqr(i,j) .GT. GM_slopeSqCutoff ) THEN
276               slopeSqr(i,j) = Large_SlopeSqr               slopeSqr(i,j) = GM_slopeSqCutoff
277               taperFct(i,j) = 0. _d 0               taperFct(i,j) = 0. _d 0
278            ENDIF            ENDIF
279           ENDDO           ENDDO
# Line 288  C-      Simplest adiabatic tapering = Sm Line 291  C-      Simplest adiabatic tapering = Sm
291            IF ( SlopeSqr(i,j) .EQ. 0. ) THEN            IF ( SlopeSqr(i,j) .EQ. 0. ) THEN
292             taperFct(i,j) = 1. _d 0             taperFct(i,j) = 1. _d 0
293            ELSE IF ( SlopeSqr(i,j) .GT. maxSlopeSqr .AND.            ELSE IF ( SlopeSqr(i,j) .GT. maxSlopeSqr .AND.
294       &             SlopeSqr(i,j) .LT. Large_SlopeSqr )  THEN       &             SlopeSqr(i,j) .LT. GM_slopeSqCutoff )  THEN
295             taperFct(i,j) = sqrt(maxSlopeSqr / SlopeSqr(i,j))             taperFct(i,j) = sqrt(maxSlopeSqr / SlopeSqr(i,j))
296            ENDIF            ENDIF
297    
# Line 305  C-      Gerdes, Koberle and Willebrand, Line 308  C-      Gerdes, Koberle and Willebrand,
308            IF ( SlopeSqr(i,j) .EQ. 0. ) THEN            IF ( SlopeSqr(i,j) .EQ. 0. ) THEN
309             taperFct(i,j) = 1. _d 0             taperFct(i,j) = 1. _d 0
310            ELSE IF ( SlopeSqr(i,j) .GT. maxSlopeSqr .AND.            ELSE IF ( SlopeSqr(i,j) .GT. maxSlopeSqr .AND.
311       &             SlopeSqr(i,j) .LT. Large_SlopeSqr ) THEN       &             SlopeSqr(i,j) .LT. GM_slopeSqCutoff ) THEN
312             taperFct(i,j) = maxSlopeSqr/SlopeSqr(i,j)             taperFct(i,j) = maxSlopeSqr/SlopeSqr(i,j)
313            ENDIF            ENDIF
314    
# Line 320  C-      Danabasoglu and McWilliams, J. C Line 323  C-      Danabasoglu and McWilliams, J. C
323    
324            IF ( SlopeSqr(i,j) .EQ. 0. ) THEN            IF ( SlopeSqr(i,j) .EQ. 0. ) THEN
325             taperFct(i,j) = 1. _d 0             taperFct(i,j) = 1. _d 0
326            ELSE IF ( SlopeSqr(i,j) .LT. Large_SlopeSqr ) THEN            ELSE IF ( SlopeSqr(i,j) .LT. GM_slopeSqCutoff ) THEN
327             Smod=sqrt(SlopeSqr(i,j))             Smod=sqrt(SlopeSqr(i,j))
328             taperFct(i,j)=op5*( 1. _d 0 + tanh( (GM_Scrit-Smod)/GM_Sd ))             taperFct(i,j)=op5*( 1. _d 0 + tanh( (GM_Scrit-Smod)/GM_Sd ))
329            ENDIF            ENDIF
# Line 335  C-      Large, Danabasoglu and Doney, JP Line 338  C-      Large, Danabasoglu and Doney, JP
338    
339            IF (SlopeSqr(i,j) .EQ. 0.) THEN            IF (SlopeSqr(i,j) .EQ. 0.) THEN
340             taperFct(i,j) = 1. _d 0             taperFct(i,j) = 1. _d 0
341            ELSE IF ( SlopeSqr(i,j) .LT. Large_SlopeSqr ) THEN            ELSE IF ( SlopeSqr(i,j) .LT. GM_slopeSqCutoff ) THEN
342             Smod=sqrt(SlopeSqr(i,j))             Smod=sqrt(SlopeSqr(i,j))
343             f1=op5*( 1. _d 0 + tanh( (GM_Scrit-Smod)/GM_Sd ))             f1=op5*( 1. _d 0 + tanh( (GM_Scrit-Smod)/GM_Sd ))
344             Cspd=2. _d 0             Cspd=2. _d 0
# Line 355  C-      Large, Danabasoglu and Doney, JP Line 358  C-      Large, Danabasoglu and Doney, JP
358          STOP 'GMREDI_SLOPE_LIMIT: Bad GM_taper_scheme'          STOP 'GMREDI_SLOPE_LIMIT: Bad GM_taper_scheme'
359         ENDIF         ENDIF
360    
361  #else /* GM_TAPER_REST */  #endif /* GM_EXCLUDE_TAPERING */
         
         STOP 'Need to compile with "#define GM_TAPER_REST"'  
   
 #endif /* GM_TAPER_REST */  
362    
363        ENDIF        ENDIF
364    
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18
  ViewVC Help
Powered by ViewVC 1.1.22