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

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

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

revision 1.10 by heimbach, Sun Mar 24 02:33:16 2002 UTC revision 1.20 by jmc, Tue Jan 4 00:19:38 2005 UTC
# Line 22  C     == Global variables == Line 22  C     == Global variables ==
22  #include "EEPARAMS.h"  #include "EEPARAMS.h"
23  #include "PARAMS.h"  #include "PARAMS.h"
24  #include "GMREDI.h"  #include "GMREDI.h"
25  #include "GMREDI_DIAGS.h"  #include "GMREDI_TAVE.h"
26    
27  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
28  #include "tamc.h"  #include "tamc.h"
# Line 41  CEndOfInterface Line 41  CEndOfInterface
41  #ifdef ALLOW_GMREDI  #ifdef ALLOW_GMREDI
42    
43  C     == Local variables ==  C     == Local variables ==
44        INTEGER i,j,k,km1,kp1        INTEGER i,j,k,kp1
45        _RL SlopeX(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL SlopeX(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
46        _RL SlopeY(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL SlopeY(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
47        _RL dSigmaDrReal(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL dSigmaDx(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
48          _RL dSigmaDy(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
49          _RL dSigmaDr(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
50        _RL SlopeSqr(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL SlopeSqr(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
51        _RL taperFct(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL taperFct(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
52        _RL maskp1, maskm1, Kgm_tmp        _RL maskp1, Kgm_tmp
53          _RL ldd97_LrhoC(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
54          _RL ldd97_LrhoW(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
55          _RL ldd97_LrhoS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
56          _RL Cspd, LrhoInf, LrhoSup, fCoriLoc
57    
58  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
59        _RS deltaH,zero_rs        _RL deltaH,zero_rs
60        PARAMETER(zero_rs=0.)        PARAMETER(zero_rs=0.D0)
61        _RL N2,SN        _RL N2,SN
62        _RL Ssq(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL Ssq(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
63  #endif  #endif
64    
65    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
66    
67  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
68            act1 = bi - myBxLo(myThid)            act1 = bi - myBxLo(myThid)
69            max1 = myBxHi(myThid) - myBxLo(myThid) + 1            max1 = myBxHi(myThid) - myBxLo(myThid) + 1
# Line 64  C     == Local variables == Line 72  C     == Local variables ==
72            act3 = myThid - 1            act3 = myThid - 1
73            max3 = nTx*nTy            max3 = nTx*nTy
74            act4 = ikey_dynamics - 1            act4 = ikey_dynamics - 1
75            ikey = (act1 + 1) + act2*max1            igmkey = (act1 + 1) + act2*max1
76       &                      + act3*max1*max2       &                      + act3*max1*max2
77       &                      + act4*max1*max2*max3       &                      + act4*max1*max2*max3
78  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
79    
80    #ifdef GM_VISBECK_VARIABLE_K
81          DO j=1-Oly,sNy+Oly
82           DO i=1-Olx,sNx+Olx
83            VisbeckK(i,j,bi,bj) = 0. _d 0
84           ENDDO
85          ENDDO
86    #endif
87    
88    C--   set ldd97_Lrho (for tapering scheme ldd97):
89          IF (GM_taper_scheme.EQ.'ldd97') THEN
90           Cspd = 2. _d 0
91           LrhoInf = 15. _d 3
92           LrhoSup = 100. _d 3
93    C-     Tracer point location (center):
94           DO j=1-Oly,sNy+Oly
95            DO i=1-Olx,sNx+Olx
96             IF (fCori(i,j,bi,bj).NE.0.) THEN
97               ldd97_LrhoC(i,j) = Cspd/ABS(fCori(i,j,bi,bj))
98             ELSE
99               ldd97_LrhoC(i,j) = LrhoSup
100             ENDIF
101             ldd97_LrhoC(i,j) = MAX(LrhoInf,MIN(ldd97_LrhoC(i,j),LrhoSup))
102            ENDDO
103           ENDDO
104    C-     U point location (West):
105           DO j=1-Oly,sNy+Oly
106            ldd97_LrhoW(1-Olx,j) = LrhoSup
107            DO i=1-Olx+1,sNx+Olx
108             fCoriLoc = op5*(fCori(i-1,j,bi,bj)+fCori(i,j,bi,bj))
109             IF (fCoriLoc.NE.0.) THEN
110               ldd97_LrhoW(i,j) = Cspd/ABS(fCoriLoc)
111             ELSE
112               ldd97_LrhoW(i,j) = LrhoSup
113             ENDIF
114             ldd97_LrhoW(i,j) = MAX(LrhoInf,MIN(ldd97_LrhoW(i,j),LrhoSup))
115            ENDDO
116           ENDDO
117    C-     V point location (South):
118           DO i=1-Olx+1,sNx+Olx
119             ldd97_LrhoS(i,1-Oly) = LrhoSup
120           ENDDO
121           DO j=1-Oly+1,sNy+Oly
122            DO i=1-Olx,sNx+Olx
123             fCoriLoc = op5*(fCori(i,j-1,bi,bj)+fCori(i,j,bi,bj))
124             IF (fCoriLoc.NE.0.) THEN
125               ldd97_LrhoS(i,j) = Cspd/ABS(fCoriLoc)
126             ELSE
127               ldd97_LrhoS(i,j) = LrhoSup
128             ENDIF
129             ldd97_LrhoS(i,j) = MAX(LrhoInf,MIN(ldd97_LrhoS(i,j),LrhoSup))
130            ENDDO
131           ENDDO
132          ELSE
133    C-    Just initialize to zero (not use anyway)
134           DO j=1-Oly,sNy+Oly
135            DO i=1-Olx,sNx+Olx
136              ldd97_LrhoC(i,j) = 0. _d 0
137              ldd97_LrhoW(i,j) = 0. _d 0
138              ldd97_LrhoS(i,j) = 0. _d 0
139            ENDDO
140           ENDDO
141          ENDIF
142    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
143    
144        DO k=2,Nr        DO k=2,Nr
145  C-- 1rst loop on k : compute Tensor Coeff. at W points.  C-- 1rst loop on k : compute Tensor Coeff. at W points.
        km1 = MAX(1,k-1)  
        maskm1 = 1. _d 0  
        IF (k.LE.1) maskm1 = 0. _d 0  
146    
147  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
148         kkey = (ikey-1)*Nr + k         kkey = (igmkey-1)*Nr + k
149         DO j=1-Oly,sNy+Oly         DO j=1-Oly,sNy+Oly
150          DO i=1-Olx,sNx+Olx          DO i=1-Olx,sNx+Olx
151           SlopeX(i,j)       = 0. _d 0           SlopeX(i,j)       = 0. _d 0
152           SlopeY(i,j)       = 0. _d 0           SlopeY(i,j)       = 0. _d 0
153           dSigmaDrReal(i,j) = 0. _d 0           dSigmaDx(i,j)     = 0. _d 0
154             dSigmaDy(i,j)     = 0. _d 0
155             dSigmaDr(i,j)     = 0. _d 0
156           SlopeSqr(i,j)     = 0. _d 0           SlopeSqr(i,j)     = 0. _d 0
157           taperFct(i,j)     = 0. _d 0           taperFct(i,j)     = 0. _d 0
158           Kwx(i,j,k,bi,bj)  = 0. _d 0           Kwx(i,j,k,bi,bj)  = 0. _d 0
159           Kwy(i,j,k,bi,bj)  = 0. _d 0           Kwy(i,j,k,bi,bj)  = 0. _d 0
160           Kwz(i,j,k,bi,bj)  = 0. _d 0           Kwz(i,j,k,bi,bj)  = 0. _d 0
161    # ifdef GM_NON_UNITY_DIAGONAL
162             Kux(i,j,k,bi,bj)  = 0. _d 0
163             Kvy(i,j,k,bi,bj)  = 0. _d 0
164    # endif
165    # ifdef GM_EXTRA_DIAGONAL
166             Kuz(i,j,k,bi,bj)  = 0. _d 0
167             Kvz(i,j,k,bi,bj)  = 0. _d 0
168    # endif
169    # ifdef GM_BOLUS_ADVEC
170             GM_PsiX(i,j,k,bi,bj)  = 0. _d 0
171             GM_PsiY(i,j,k,bi,bj)  = 0. _d 0
172    # endif
173          ENDDO          ENDDO
174         ENDDO         ENDDO
175  #endif  #endif
176    
177        DO j=1-Oly+1,sNy+Oly-1        DO j=1-Oly+1,sNy+Oly-1
178         DO i=1-Olx+1,sNx+Olx-1         DO i=1-Olx+1,sNx+Olx-1
   
179  C      Gradient of Sigma at rVel points  C      Gradient of Sigma at rVel points
180          SlopeX(i,j)=0.25*( sigmaX(i+1, j ,km1) +sigmaX(i,j,km1)          dSigmaDx(i,j)=op25*( sigmaX(i+1, j ,k-1) +sigmaX(i,j,k-1)
181       &                    +sigmaX(i+1, j , k ) +sigmaX(i,j, k ) )       &                    +sigmaX(i+1, j , k ) +sigmaX(i,j, k ) )
182       &                  *maskC(i,j,k,bi,bj)*maskm1       &                  *maskC(i,j,k,bi,bj)
183          SlopeY(i,j)=0.25*( sigmaY( i ,j+1,km1) +sigmaY(i,j,km1)          dSigmaDy(i,j)=op25*( sigmaY( i ,j+1,k-1) +sigmaY(i,j,k-1)
184       &                    +sigmaY( i ,j+1, k ) +sigmaY(i,j, k ) )       &                    +sigmaY( i ,j+1, k ) +sigmaY(i,j, k ) )
185       &                  *maskC(i,j,k,bi,bj)*maskm1       &                  *maskC(i,j,k,bi,bj)
186          dSigmaDrReal(i,j)=sigmaR(i,j,k)*maskm1          dSigmaDr(i,j)=sigmaR(i,j,k)
   
187         ENDDO         ENDDO
188        ENDDO        ENDDO
189    
190  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
191  CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDx(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
192  CADJ STORE SlopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDy(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
193  CADJ STORE dsigmadrreal(:,:) = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDr(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
194  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
195    
196  C     Calculate slopes for use in tensor, taper and/or clip  C     Calculate slopes for use in tensor, taper and/or clip
197        CALL GMREDI_SLOPE_LIMIT(        CALL GMREDI_SLOPE_LIMIT(
198       U             dSigmadRReal,       O             SlopeX, SlopeY,
      I             rF(K),  
      U             SlopeX, SlopeY,  
199       O             SlopeSqr, taperFct,       O             SlopeSqr, taperFct,
200         U             dSigmaDr,
201         I             dSigmaDx, dSigmaDy,
202         I             ldd97_LrhoC,rF(k),k,
203       I             bi, bj, myThid )       I             bi, bj, myThid )
204    
205        DO j=1-Oly+1,sNy+Oly-1        DO j=1-Oly+1,sNy+Oly-1
206         DO i=1-Olx+1,sNx+Olx-1         DO i=1-Olx+1,sNx+Olx-1
207    
208  C       Mask Iso-neutral slopes  C       Mask Iso-neutral slopes
209          SlopeX(i,j)=SlopeX(i,j)*maskC(i,j,k,bi,bj)*maskm1          SlopeX(i,j)=SlopeX(i,j)*maskC(i,j,k,bi,bj)
210          SlopeY(i,j)=SlopeY(i,j)*maskC(i,j,k,bi,bj)*maskm1          SlopeY(i,j)=SlopeY(i,j)*maskC(i,j,k,bi,bj)
211          SlopeSqr(i,j)=SlopeSqr(i,j)*maskC(i,j,k,bi,bj)*maskm1          SlopeSqr(i,j)=SlopeSqr(i,j)*maskC(i,j,k,bi,bj)
212    
213         ENDDO         ENDDO
214        ENDDO        ENDDO
# Line 135  C       Mask Iso-neutral slopes Line 217  C       Mask Iso-neutral slopes
217  CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
218  CADJ STORE SlopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE SlopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
219  CADJ STORE SlopeSqr(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE SlopeSqr(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte
220    CADJ STORE dSigmaDr(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte
221    CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte
222  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
223    
224        DO j=1-Oly+1,sNy+Oly-1        DO j=1-Oly+1,sNy+Oly-1
# Line 148  C       Components of Redi/GM tensor Line 232  C       Components of Redi/GM tensor
232  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
233    
234  C- note (jmc) : moved here since only used in VISBECK_VARIABLE_K  C- note (jmc) : moved here since only used in VISBECK_VARIABLE_K
235  C           but don't know if *taperFct (or **2 ?) is necessary  C           but do not know if *taperFct (or **2 ?) is necessary
236          Ssq(i,j)=SlopeSqr(i,j)*taperFct(i,j)          Ssq(i,j)=SlopeSqr(i,j)*taperFct(i,j)
237    
238  C--     Depth average of M^2/N^2 * N  C--     Depth average of M^2/N^2 * N
# Line 165  C       Now we convert deltaH to a non-d Line 249  C       Now we convert deltaH to a non-d
249          deltaH=deltaH/GM_Visbeck_depth          deltaH=deltaH/GM_Visbeck_depth
250    
251          IF (K.eq.2) VisbeckK(i,j,bi,bj)=0.          IF (K.eq.2) VisbeckK(i,j,bi,bj)=0.
252          IF (Ssq(i,j).NE.0.) THEN          IF ( Ssq(i,j).NE.0. .AND. dSigmaDr(i,j).NE.0. ) THEN
253           N2= -Gravity*recip_Rhonil*dSigmaDrReal(i,j)           N2= -Gravity*recip_RhoConst*dSigmaDr(i,j)
254           SN=sqrt(Ssq(i,j)*N2)           SN=sqrt(Ssq(i,j)*N2)
255           VisbeckK(i,j,bi,bj)=VisbeckK(i,j,bi,bj)+deltaH           VisbeckK(i,j,bi,bj)=VisbeckK(i,j,bi,bj)+deltaH
256       &      *GM_Visbeck_alpha*GM_Visbeck_length*GM_Visbeck_length*SN       &      *GM_Visbeck_alpha*GM_Visbeck_length*GM_Visbeck_length*SN
# Line 182  C-- end 1rst loop on vertical level inde Line 266  C-- end 1rst loop on vertical level inde
266    
267    
268  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
269    #ifdef ALLOW_AUTODIFF_TAMC
270    CADJ STORE VisbeckK(:,:,bi,bj) = comlev1_bibj, key=igmkey, byte=isbyte
271    #endif
272        IF ( GM_Visbeck_alpha.NE.0. ) THEN        IF ( GM_Visbeck_alpha.NE.0. ) THEN
273  C-     Limit range that KapGM can take  C-     Limit range that KapGM can take
274         DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
275          DO i=1-Olx+1,sNx+Olx-1          DO i=1-Olx+1,sNx+Olx-1
276           VisbeckK(i,j,bi,bj)=           VisbeckK(i,j,bi,bj)=
277       &       MIN(VisbeckK(i,j,bi,bj),GM_Visbeck_maxval_K)       &       MIN(VisbeckK(i,j,bi,bj),GM_Visbeck_maxval_K)
 #ifdef ALLOW_TIMEAVE  
          Visbeck_K_T(i,j,bi,bj)=Visbeck_K_T(i,j,bi,bj)  
      &                         +VisbeckK(i,j,bi,bj)*deltaTclock  
 #endif  
278          ENDDO          ENDDO
279         ENDDO         ENDDO
280        ENDIF        ENDIF
281    cph( NEW
282    #ifdef ALLOW_AUTODIFF_TAMC
283    CADJ STORE VisbeckK(:,:,bi,bj) = comlev1_bibj, key=igmkey, byte=isbyte
284    #endif
285    cph)
286  #endif /* GM_VISBECK_VARIABLE_K */  #endif /* GM_VISBECK_VARIABLE_K */
287    
288    
# Line 206  C-- 2nd loop on k : compute Tensor Coeff Line 294  C-- 2nd loop on k : compute Tensor Coeff
294         maskp1 = 1. _d 0         maskp1 = 1. _d 0
295         IF (k.GE.Nr) maskp1 = 0. _d 0         IF (k.GE.Nr) maskp1 = 0. _d 0
296    
297    #ifdef ALLOW_AUTODIFF_TAMC
298           kkey = (igmkey-1)*Nr + k
299    #if (defined (GM_NON_UNITY_DIAGONAL) || \
300         defined (GM_VISBECK_VARIABLE_K))
301    CADJ STORE Kwx(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
302    CADJ STORE Kwy(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
303    CADJ STORE Kwz(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
304    #endif
305    #endif
306    
307  C-    express the Tensor in term of Diffusivity (= m**2 / s )  C-    express the Tensor in term of Diffusivity (= m**2 / s )
308        DO j=1-Oly+1,sNy+Oly-1        DO j=1-Oly+1,sNy+Oly-1
309         DO i=1-Olx+1,sNx+Olx-1         DO i=1-Olx+1,sNx+Olx-1
310          Kgm_tmp = GM_isopycK + GM_skewflx*GM_background_K          Kgm_tmp = GM_isopycK + GM_skewflx*GM_background_K
311  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
312       &          + VisbeckK(i,j,bi,bj)*(1.+GM_skewflx)           &          + VisbeckK(i,j,bi,bj)*(1. _d 0 + GM_skewflx)    
313  #endif  #endif
314          Kwx(i,j,k,bi,bj)= Kgm_tmp*Kwx(i,j,k,bi,bj)          Kwx(i,j,k,bi,bj)= Kgm_tmp*Kwx(i,j,k,bi,bj)
315          Kwy(i,j,k,bi,bj)= Kgm_tmp*Kwy(i,j,k,bi,bj)          Kwy(i,j,k,bi,bj)= Kgm_tmp*Kwy(i,j,k,bi,bj)
# Line 228  C-    express the Tensor in term of Diff Line 326  C-    express the Tensor in term of Diff
326  C     Gradient of Sigma at U points  C     Gradient of Sigma at U points
327        DO j=1-Oly+1,sNy+Oly-1        DO j=1-Oly+1,sNy+Oly-1
328         DO i=1-Olx+1,sNx+Olx-1         DO i=1-Olx+1,sNx+Olx-1
329          SlopeX(i,j)=sigmaX(i,j,k)          dSigmaDx(i,j)=sigmaX(i,j,k)
330       &          *_maskW(i,j,k,bi,bj)       &          *_maskW(i,j,k,bi,bj)
331          SlopeY(i,j)=0.25*( sigmaY(i-1,j+1,k) +sigmaY(i,j+1,k)          dSigmaDy(i,j)=op25*( sigmaY(i-1,j+1,k) +sigmaY(i,j+1,k)
332       &                    +sigmaY(i-1, j ,k) +sigmaY(i, j ,k) )       &                      +sigmaY(i-1, j ,k) +sigmaY(i, j ,k) )
333       &          *_maskW(i,j,k,bi,bj)       &          *_maskW(i,j,k,bi,bj)
334          dSigmaDrReal(i,j)=0.25*( sigmaR(i-1,j, k ) +sigmaR(i,j, k )          dSigmaDr(i,j)=op25*( sigmaR(i-1,j, k ) +sigmaR(i,j, k )
335       &                  +maskp1*(sigmaR(i-1,j,kp1) +sigmaR(i,j,kp1)) )       &                  +maskp1*(sigmaR(i-1,j,kp1) +sigmaR(i,j,kp1)) )
336       &          *_maskW(i,j,k,bi,bj)       &          *_maskW(i,j,k,bi,bj)
337         ENDDO         ENDDO
338        ENDDO        ENDDO
339    
340    #ifdef ALLOW_AUTODIFF_TAMC
341    CADJ STORE SlopeSqr(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
342    CADJ STORE dSigmaDx(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
343    CADJ STORE dSigmaDy(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
344    CADJ STORE dSigmaDr(:,:)   = comlev1_bibj_k, key=kkey, byte=isbyte
345    #endif /* ALLOW_AUTODIFF_TAMC */
346    
347  C     Calculate slopes for use in tensor, taper and/or clip  C     Calculate slopes for use in tensor, taper and/or clip
348        CALL GMREDI_SLOPE_LIMIT(        CALL GMREDI_SLOPE_LIMIT(
349       U             dSigmadRReal,       O             SlopeX, SlopeY,
      I             rF(K),  
      U             SlopeX, SlopeY,  
350       O             SlopeSqr, taperFct,       O             SlopeSqr, taperFct,
351         U             dSigmaDr,
352         I             dSigmaDx, dSigmaDy,
353         I             ldd97_LrhoW,rC(k),k,
354       I             bi, bj, myThid )       I             bi, bj, myThid )
355    
356    cph( NEW
357    #ifdef ALLOW_AUTODIFF_TAMC
358    cph(
359    CADJ STORE SlopeSqr(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
360    CADJ STORE taperFct(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
361    cph)
362    #endif /* ALLOW_AUTODIFF_TAMC */
363    cph)
364    
365  #ifdef GM_NON_UNITY_DIAGONAL  #ifdef GM_NON_UNITY_DIAGONAL
366          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
367           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
368            Kux(i,j,k,bi,bj) =            Kux(i,j,k,bi,bj) =
369       &     ( GM_isopycK       &     ( GM_isopycK
370  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
371       &     +0.5*(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))
372  #endif  #endif
373       &     )       &     )
374       &     *taperFct(i,j)       &     *taperFct(i,j)
375           ENDDO           ENDDO
376          ENDDO          ENDDO
377    #ifdef ALLOW_AUTODIFF_TAMC
378    # ifdef GM_EXCLUDE_CLIPPING
379    CADJ STORE Kux(:,:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte
380    # endif
381    #endif
382          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
383           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
384            Kux(i,j,k,bi,bj) = MAX( Kux(i,j,k,bi,bj), GM_Kmin_horiz )            Kux(i,j,k,bi,bj) = MAX( Kux(i,j,k,bi,bj), GM_Kmin_horiz )
# Line 267  C     Calculate slopes for use in tensor Line 387  C     Calculate slopes for use in tensor
387  #endif /* GM_NON_UNITY_DIAGONAL */  #endif /* GM_NON_UNITY_DIAGONAL */
388    
389  #ifdef GM_EXTRA_DIAGONAL  #ifdef GM_EXTRA_DIAGONAL
390    
391    #ifdef ALLOW_AUTODIFF_TAMC
392    CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
393    CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte
394    #endif /* ALLOW_AUTODIFF_TAMC */
395        IF (GM_ExtraDiag) THEN        IF (GM_ExtraDiag) THEN
396          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
397           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
398            Kuz(i,j,k,bi,bj) =            Kuz(i,j,k,bi,bj) =
399       &     ( GM_isopycK - GM_skewflx*GM_background_K       &     ( GM_isopycK - GM_skewflx*GM_background_K
400  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
401       &     +0.5*(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))*GM_advect       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))*GM_advect
402  #endif  #endif
403       &     )*SlopeX(i,j)*taperFct(i,j)       &     )*SlopeX(i,j)*taperFct(i,j)
404           ENDDO           ENDDO
# Line 284  C     Calculate slopes for use in tensor Line 409  C     Calculate slopes for use in tensor
409  C     Gradient of Sigma at V points  C     Gradient of Sigma at V points
410        DO j=1-Oly+1,sNy+Oly-1        DO j=1-Oly+1,sNy+Oly-1
411         DO i=1-Olx+1,sNx+Olx-1         DO i=1-Olx+1,sNx+Olx-1
412          SlopeX(i,j)=0.25*( sigmaX(i, j ,k) +sigmaX(i+1, j ,k)          dSigmaDx(i,j)=op25*( sigmaX(i, j ,k) +sigmaX(i+1, j ,k)
413       &                    +sigmaX(i,j-1,k) +sigmaX(i+1,j-1,k) )       &                    +sigmaX(i,j-1,k) +sigmaX(i+1,j-1,k) )
414       &          *_maskS(i,j,k,bi,bj)       &          *_maskS(i,j,k,bi,bj)
415          SlopeY(i,j)=sigmaY(i,j,k)          dSigmaDy(i,j)=sigmaY(i,j,k)
416       &          *_maskS(i,j,k,bi,bj)       &          *_maskS(i,j,k,bi,bj)
417          dSigmaDrReal(i,j)=0.25*( sigmaR(i,j-1, k ) +sigmaR(i,j, k )          dSigmaDr(i,j)=op25*( sigmaR(i,j-1, k ) +sigmaR(i,j, k )
418       &                  +maskp1*(sigmaR(i,j-1,kp1) +sigmaR(i,j,kp1)) )       &                  +maskp1*(sigmaR(i,j-1,kp1) +sigmaR(i,j,kp1)) )
419       &          *_maskS(i,j,k,bi,bj)       &          *_maskS(i,j,k,bi,bj)
420         ENDDO         ENDDO
421        ENDDO        ENDDO
422    
423    #ifdef ALLOW_AUTODIFF_TAMC
424    CADJ STORE dSigmaDx(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
425    CADJ STORE dSigmaDy(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
426    CADJ STORE dSigmaDr(:,:)   = comlev1_bibj_k, key=kkey, byte=isbyte
427    #endif /* ALLOW_AUTODIFF_TAMC */
428    
429  C     Calculate slopes for use in tensor, taper and/or clip  C     Calculate slopes for use in tensor, taper and/or clip
430        CALL GMREDI_SLOPE_LIMIT(        CALL GMREDI_SLOPE_LIMIT(
431       U             dSigmadRReal,       O             SlopeX, SlopeY,
      I             rF(K),  
      U             SlopeX, SlopeY,  
432       O             SlopeSqr, taperFct,       O             SlopeSqr, taperFct,
433         U             dSigmaDr,
434         I             dSigmaDx, dSigmaDy,
435         I             ldd97_LrhoS,rC(k),k,
436       I             bi, bj, myThid )       I             bi, bj, myThid )
437    
438    cph(
439    #ifdef ALLOW_AUTODIFF_TAMC
440    cph(
441    CADJ STORE taperfct(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
442    cph)
443    #endif /* ALLOW_AUTODIFF_TAMC */
444    cph)
445    
446  #ifdef GM_NON_UNITY_DIAGONAL  #ifdef GM_NON_UNITY_DIAGONAL
447          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
448           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
449            Kvy(i,j,k,bi,bj) =            Kvy(i,j,k,bi,bj) =
450       &     ( GM_isopycK       &     ( GM_isopycK
451  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
452       &     +0.5*(VisbeckK(i,j,bi,bj)+VisbeckK(i,j-1,bi,bj))       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i,j-1,bi,bj))
453  #endif  #endif
454       &     )       &     )
455       &     *taperFct(i,j)       &     *taperFct(i,j)
456           ENDDO           ENDDO
457          ENDDO          ENDDO
458    #ifdef ALLOW_AUTODIFF_TAMC
459    # ifdef GM_EXCLUDE_CLIPPING
460    CADJ STORE Kvy(:,:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte
461    # endif
462    #endif
463          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
464           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
465            Kvy(i,j,k,bi,bj) = MAX( Kvy(i,j,k,bi,bj), GM_Kmin_horiz )            Kvy(i,j,k,bi,bj) = MAX( Kvy(i,j,k,bi,bj), GM_Kmin_horiz )
# Line 323  C     Calculate slopes for use in tensor Line 468  C     Calculate slopes for use in tensor
468  #endif /* GM_NON_UNITY_DIAGONAL */  #endif /* GM_NON_UNITY_DIAGONAL */
469    
470  #ifdef GM_EXTRA_DIAGONAL  #ifdef GM_EXTRA_DIAGONAL
471    
472    #ifdef ALLOW_AUTODIFF_TAMC
473    CADJ STORE SlopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
474    CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte
475    #endif /* ALLOW_AUTODIFF_TAMC */
476        IF (GM_ExtraDiag) THEN        IF (GM_ExtraDiag) THEN
477          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
478           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
479            Kvz(i,j,k,bi,bj) =            Kvz(i,j,k,bi,bj) =
480       &     ( GM_isopycK - GM_skewflx*GM_background_K       &     ( GM_isopycK - GM_skewflx*GM_background_K
481  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
482       &     +0.5*(VisbeckK(i,j,bi,bj)+VisbeckK(i,j-1,bi,bj))*GM_advect       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i,j-1,bi,bj))*GM_advect
483  #endif  #endif
484       &     )*SlopeY(i,j)*taperFct(i,j)       &     )*SlopeY(i,j)*taperFct(i,j)
485           ENDDO           ENDDO
# Line 339  C     Calculate slopes for use in tensor Line 489  C     Calculate slopes for use in tensor
489    
490  #endif /* GM_NON_UNITY_DIAGONAL || GM_EXTRA_DIAGONAL */  #endif /* GM_NON_UNITY_DIAGONAL || GM_EXTRA_DIAGONAL */
491    
 #ifdef ALLOW_TIMEAVE  
 C--   Time-average  
       DO j=1-Oly+1,sNy+Oly-1  
        DO i=1-Olx+1,sNx+Olx-1  
         GM_Kwx_T(i,j,k,bi,bj)=GM_Kwx_T(i,j,k,bi,bj)  
      &                       +Kwx(i,j,k,bi,bj)*deltaTclock  
         GM_Kwy_T(i,j,k,bi,bj)=GM_Kwy_T(i,j,k,bi,bj)  
      &                       +Kwy(i,j,k,bi,bj)*deltaTclock  
         GM_Kwz_T(i,j,k,bi,bj)=GM_Kwz_T(i,j,k,bi,bj)  
      &                       +Kwz(i,j,k,bi,bj)*deltaTclock  
        ENDDO  
       ENDDO  
       GM_TimeAve(k,bi,bj)=GM_TimeAve(k,bi,bj)+deltaTclock  
 #endif /* ALLOW_TIMEAVE */  
   
492  C-- end 2nd loop on vertical level index k  C-- end 2nd loop on vertical level index k
493        ENDDO        ENDDO
494    
# Line 363  C-- end 2nd loop on vertical level index Line 498  C-- end 2nd loop on vertical level index
498          CALL GMREDI_CALC_PSI_B(          CALL GMREDI_CALC_PSI_B(
499       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
500       I             sigmaX, sigmaY, sigmaR,       I             sigmaX, sigmaY, sigmaR,
501         I             ldd97_LrhoW, ldd97_LrhoS,
502       I             myThid )       I             myThid )
503        ENDIF        ENDIF
504  #endif  #endif
505    
506    #ifdef ALLOW_TIMEAVE
507    C--   Time-average
508          IF ( taveFreq.GT.0. ) THEN
509    
510             CALL TIMEAVE_CUMULATE( GM_Kwx_T, Kwx, Nr,
511         &                          deltaTclock, bi, bj, myThid )
512             CALL TIMEAVE_CUMULATE( GM_Kwy_T, Kwy, Nr,
513         &                          deltaTclock, bi, bj, myThid )
514             CALL TIMEAVE_CUMULATE( GM_Kwz_T, Kwz, Nr,
515         &                          deltaTclock, bi, bj, myThid )
516    #ifdef GM_VISBECK_VARIABLE_K
517           IF ( GM_Visbeck_alpha.NE.0. ) THEN
518             CALL TIMEAVE_CUMULATE( Visbeck_K_T, VisbeckK, 1,
519         &                          deltaTclock, bi, bj, myThid )
520           ENDIF
521    #endif
522    #ifdef GM_BOLUS_ADVEC
523           IF ( GM_AdvForm ) THEN
524             CALL TIMEAVE_CUMULATE( GM_PsiXtave, GM_PsiX, Nr,
525         &                          deltaTclock, bi, bj, myThid )
526             CALL TIMEAVE_CUMULATE( GM_PsiYtave, GM_PsiY, Nr,
527         &                          deltaTclock, bi, bj, myThid )
528           ENDIF
529    #endif
530           DO k=1,Nr
531             GM_TimeAve(k,bi,bj)=GM_TimeAve(k,bi,bj)+deltaTclock
532           ENDDO
533    
534          ENDIF
535    #endif /* ALLOW_TIMEAVE */
536    
537    #ifdef ALLOW_DIAGNOSTICS
538          IF ( useDiagnostics ) THEN
539    
540    #ifdef GM_VISBECK_VARIABLE_K
541           IF ( GM_Visbeck_alpha.NE.0. ) THEN
542             CALL DIAGNOSTICS_FILL(VisbeckK,'GM_VisbK',0,1,1,bi,bj,myThid)
543           ENDIF
544    #endif
545    #ifdef GM_NON_UNITY_DIAGONAL
546             CALL DIAGNOSTICS_FILL(Kux,'GM_Kux  ',0,Nr,1,bi,bj,myThid)
547             CALL DIAGNOSTICS_FILL(Kvy,'GM_Kvy  ',0,Nr,1,bi,bj,myThid)
548    #endif
549    #ifdef GM_EXTRA_DIAGONAL
550           IF ( GM_ExtraDiag ) THEN
551             CALL DIAGNOSTICS_FILL(Kuz,'GM_Kuz  ',0,Nr,1,bi,bj,myThid)
552             CALL DIAGNOSTICS_FILL(Kvz,'GM_Kvz  ',0,Nr,1,bi,bj,myThid)
553           ENDIF
554    #endif
555             CALL DIAGNOSTICS_FILL(Kwx,'GM_Kwx  ',0,Nr,1,bi,bj,myThid)
556             CALL DIAGNOSTICS_FILL(Kwy,'GM_Kwy  ',0,Nr,1,bi,bj,myThid)
557             CALL DIAGNOSTICS_FILL(Kwz,'GM_Kwz  ',0,Nr,1,bi,bj,myThid)
558    #ifdef GM_BOLUS_ADVEC
559           IF ( GM_AdvForm ) THEN
560             CALL DIAGNOSTICS_FILL(GM_PsiX,'GM_PsiX ',0,Nr,1,bi,bj,myThid)
561             CALL DIAGNOSTICS_FILL(GM_PsiY,'GM_PsiY ',0,Nr,1,bi,bj,myThid)
562           ENDIF
563    #endif
564          ENDIF
565    #endif /* ALLOW_DIAGNOSTICS */
566    
567  #endif /* ALLOW_GMREDI */  #endif /* ALLOW_GMREDI */
568    
569        RETURN        RETURN
# Line 386  C     \================================= Line 583  C     \=================================
583    
584  C     == Global variables ==  C     == Global variables ==
585  #include "SIZE.h"  #include "SIZE.h"
 #include "GRID.h"  
 #include "DYNVARS.h"  
586  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "PARAMS.h"  
587  #include "GMREDI.h"  #include "GMREDI.h"
588    
589  C     == Routine arguments ==  C     == Routine arguments ==
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.20
  ViewVC Help
Powered by ViewVC 1.1.22