/[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.9 by jmc, Sun Dec 16 18:54:49 2001 UTC revision 1.10 by heimbach, Fri Jan 11 17:29:16 2002 UTC
# Line 32  C     == Global variables == Line 32  C     == Global variables ==
32  #include "EEPARAMS.h"  #include "EEPARAMS.h"
33  #include "GMREDI.h"  #include "GMREDI.h"
34  #include "PARAMS.h"  #include "PARAMS.h"
35    #ifdef ALLOW_AUTODIFF_TAMC
36    #include "tamc.h"
37    #include "tamc_keys.h"
38    #endif /* ALLOW_AUTODIFF_TAMC */
39    
40  C     == Routine arguments ==  C     == Routine arguments ==
41  C  C
# Line 49  CEndOfInterface Line 53  CEndOfInterface
53  C     == Local variables ==  C     == Local variables ==
54        _RL Small_Number        _RL Small_Number
55        PARAMETER(Small_Number=1.D-12)        PARAMETER(Small_Number=1.D-12)
56        _RL gradSmod,f1,Smod,f2,Rnondim,Cspd,Lrho        _RL gradSmod(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
57        _RL dSigmaDrLtd, dRdSigmaLtd        _RL dSigmaDrLtd(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
58          _RL dRdSigmaLtd(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
59          _RL f1,Smod,f2,Rnondim,Cspd,Lrho
60        _RL maxSlopeSqr        _RL maxSlopeSqr
61        _RL fpi        _RL fpi
62        PARAMETER(fpi=3.141592653589793047592d0)        PARAMETER(fpi=3.141592653589793047592d0)
63        INTEGER i,j        INTEGER i,j
64    
65    #ifdef ALLOW_AUTODIFF_TAMC
66              act1 = bi - myBxLo(myThid)
67              max1 = myBxHi(myThid) - myBxLo(myThid) + 1
68              act2 = bj - myByLo(myThid)
69              max2 = myByHi(myThid) - myByLo(myThid) + 1
70              act3 = myThid - 1
71              max3 = nTx*nTy
72              act4 = ikey_dynamics - 1
73              ikey = (act1 + 1) + act2*max1
74         &                      + act3*max1*max2
75         &                      + act4*max1*max2*max3
76    #endif /* ALLOW_AUTODIFF_TAMC */
77    
78        IF (GM_taper_scheme.EQ.'orig' .OR.        IF (GM_taper_scheme.EQ.'orig' .OR.
79       &    GM_taper_scheme.EQ.'clipping') THEN       &    GM_taper_scheme.EQ.'clipping') THEN
80    
# Line 65  C       (this turns out to be the same a Line 84  C       (this turns out to be the same a
84  C-      Cox 1987 "Slope clipping"  C-      Cox 1987 "Slope clipping"
85          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
86           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
87              gradSmod(i,j)=SlopeX(i,j)*SlopeX(i,j)
           gradSmod=SlopeX(i,j)*SlopeX(i,j)  
88       &            +SlopeY(i,j)*SlopeY(i,j)       &            +SlopeY(i,j)*SlopeY(i,j)
89            if (gradSmod .NE. 0.) gradSmod=sqrt(gradSmod)           ENDDO
90            ENDDO
91    
92    #ifdef ALLOW_AUTODIFF_TAMC
93    CADJ STORE gradSmod(:,:)     = comlev1_bibj, key=ikey, byte=isbyte
94    #endif
95    
96            DO j=1-Oly+1,sNy+Oly-1
97             DO i=1-Olx+1,sNx+Olx-1
98              if (gradSmod(i,j) .NE. 0.) gradSmod(i,j)=sqrt(gradSmod(i,j))
99             ENDDO
100            ENDDO
101    
102            dSigmaDrLtd = -(Small_Number+gradSmod*GM_rMaxSlope)  #ifdef ALLOW_AUTODIFF_TAMC
103            IF (dSigmaDrReal(i,j).GE.dSigmaDrLtd)  CADJ STORE gradSmod(:,:)     = comlev1_bibj, key=ikey, byte=isbyte
104       &        dSigmaDrReal(i,j) = dSigmaDrLtd  CADJ STORE dSigmaDrReal(:,:) = comlev1_bibj, key=ikey, byte=isbyte
105            dRdSigmaLtd = 1./dSigmaDrReal(i,j)  #endif
106    
107            SlopeX(i,j)=-SlopeX(i,j)*dRdSigmaLtd          DO j=1-Oly+1,sNy+Oly-1
108            SlopeY(i,j)=-SlopeY(i,j)*dRdSigmaLtd           DO i=1-Olx+1,sNx+Olx-1
109              dSigmaDrLtd(i,j) = -(Small_Number+gradSmod(i,j)*GM_rMaxSlope)
110              IF (dSigmaDrReal(i,j).GE.dSigmaDrLtd(i,j))
111         &        dSigmaDrReal(i,j) = dSigmaDrLtd(i,j)
112             ENDDO
113            ENDDO
114    
115    #ifdef ALLOW_AUTODIFF_TAMC
116    CADJ STORE slopeX(:,:)       = comlev1_bibj, key=ikey, byte=isbyte
117    CADJ STORE slopeY(:,:)       = comlev1_bibj, key=ikey, byte=isbyte
118    CADJ STORE dSigmaDrReal(:,:) = comlev1_bibj, key=ikey, byte=isbyte
119    #endif
120    
121            DO j=1-Oly+1,sNy+Oly-1
122             DO i=1-Olx+1,sNx+Olx-1
123              dRdSigmaLtd(i,j) = 1./dSigmaDrReal(i,j)
124              SlopeX(i,j)=-SlopeX(i,j)*dRdSigmaLtd(i,j)
125              SlopeY(i,j)=-SlopeY(i,j)*dRdSigmaLtd(i,j)
126             ENDDO
127            ENDDO
128    
129    #ifdef ALLOW_AUTODIFF_TAMC
130    CADJ STORE slopeX(:,:)       = comlev1_bibj, key=ikey, byte=isbyte
131    CADJ STORE slopeY(:,:)       = comlev1_bibj, key=ikey, byte=isbyte
132    #endif
133    
134            DO j=1-Oly+1,sNy+Oly-1
135             DO i=1-Olx+1,sNx+Olx-1
136            SlopeSqr(i,j)=SlopeX(i,j)*SlopeX(i,j)            SlopeSqr(i,j)=SlopeX(i,j)*SlopeX(i,j)
137       &                 +SlopeY(i,j)*SlopeY(i,j)       &                 +SlopeY(i,j)*SlopeY(i,j)
138            taperFct(i,j)=1. _d 0            taperFct(i,j)=1. _d 0
# Line 86  C-      Cox 1987 "Slope clipping" Line 142  C-      Cox 1987 "Slope clipping"
142    
143        ELSE        ELSE
144    
145  C- Compute the slope, no clipping, but avoid reverse slope in negatively  C- Compute the slope, no clipping, but avoid reverse slope in negatively
146  C                                  stratified (Sigma_Z > 0) region :  C                                  stratified (Sigma_Z > 0) region :
147    
148    #ifdef ALLOW_AUTODIFF_TAMC
149    CADJ STORE dSigmaDrReal(:,:) = comlev1_bibj, key=ikey, byte=isbyte
150    #endif
151    
152            DO j=1-Oly+1,sNy+Oly-1
153             DO i=1-Olx+1,sNx+Olx-1
154              dSigmaDrLtd(i,j) = -Small_Number
155              IF (dSigmaDrReal(i,j).GE.dSigmaDrLtd(i,j))
156         &        dSigmaDrReal(i,j) = dSigmaDrLtd(i,j)
157             ENDDO
158            ENDDO
159    
160    #ifdef ALLOW_AUTODIFF_TAMC
161    CADJ STORE slopeX(:,:)       = comlev1_bibj, key=ikey, byte=isbyte
162    CADJ STORE slopeY(:,:)       = comlev1_bibj, key=ikey, byte=isbyte
163    CADJ STORE dSigmaDrReal(:,:) = comlev1_bibj, key=ikey, byte=isbyte
164    #endif
165    
166          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
167           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
168              dRdSigmaLtd(i,j) = 1./dSigmaDrReal(i,j)
169              SlopeX(i,j) = -SlopeX(i,j)*dRdSigmaLtd(i,j)
170              SlopeY(i,j) = -SlopeY(i,j)*dRdSigmaLtd(i,j)
171             ENDDO
172            ENDDO
173    
174            dSigmaDrLtd = -Small_Number  #ifdef ALLOW_AUTODIFF_TAMC
175            IF (dSigmaDrReal(i,j).GE.dSigmaDrLtd)  CADJ STORE slopeX(:,:)       = comlev1_bibj, key=ikey, byte=isbyte
176       &        dSigmaDrReal(i,j) = dSigmaDrLtd  CADJ STORE slopeY(:,:)       = comlev1_bibj, key=ikey, byte=isbyte
177            dRdSigmaLtd = 1./dSigmaDrReal(i,j)  #endif
178    
179            SlopeX(i,j) = -SlopeX(i,j)*dRdSigmaLtd          DO j=1-Oly+1,sNy+Oly-1
180            SlopeY(i,j) = -SlopeY(i,j)*dRdSigmaLtd           DO i=1-Olx+1,sNx+Olx-1
181            SlopeSqr(i,j)=SlopeX(i,j)*SlopeX(i,j)            SlopeSqr(i,j)=SlopeX(i,j)*SlopeX(i,j)
182       &                 +SlopeY(i,j)*SlopeY(i,j)       &                 +SlopeY(i,j)*SlopeY(i,j)
183            taperFct(i,j)=1. _d 0            taperFct(i,j)=1. _d 0
   
184           ENDDO           ENDDO
185          ENDDO          ENDDO
186    
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22