/[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.14 by heimbach, Fri Jan 10 00:48:39 2003 UTC revision 1.21 by heimbach, Wed Oct 26 20:53:14 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 dSigmaDx(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)        _RL dSigmaDy(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
49        _RL dSigmaDrReal(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _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        _RL deltaH,zero_rs        _RL deltaH,zero_rs
# Line 58  C     == Local variables == Line 62  C     == Local variables ==
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 79  C     == Local variables == Line 85  C     == Local variables ==
85        ENDDO        ENDDO
86  #endif  #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 = (igmkey-1)*Nr + k         kkey = (igmkey-1)*Nr + k
# Line 93  C-- 1rst loop on k : compute Tensor Coef Line 152  C-- 1rst loop on k : compute Tensor Coef
152           SlopeY(i,j)       = 0. _d 0           SlopeY(i,j)       = 0. _d 0
153           dSigmaDx(i,j)     = 0. _d 0           dSigmaDx(i,j)     = 0. _d 0
154           dSigmaDy(i,j)     = 0. _d 0           dSigmaDy(i,j)     = 0. _d 0
155           dSigmaDrReal(i,j) = 0. _d 0           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
# Line 118  C-- 1rst loop on k : compute Tensor Coef Line 177  C-- 1rst loop on k : compute Tensor Coef
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          dSigmaDx(i,j)=op25*( 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          dSigmaDy(i,j)=op25*( 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 dSigmaDx(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDx(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
192  CADJ STORE dSigmaDy(:,:)       = 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),K,  
      U             SlopeX, SlopeY,  
      U             dSigmaDx, dSigmaDy,  
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
215    
216  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
217    CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
218    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 169  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 186  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. .AND. dSigmaDrReal(i,j).NE.0. ) THEN          IF ( Ssq(i,j).NE.0. .AND. dSigmaDr(i,j).NE.0. ) THEN
253           N2= -Gravity*recip_RhoConst*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 212  C-     Limit range that KapGM can take Line 275  C-     Limit range that KapGM can take
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 232  C-- 2nd loop on k : compute Tensor Coeff Line 296  C-- 2nd loop on k : compute Tensor Coeff
296    
297  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
298         kkey = (igmkey-1)*Nr + k         kkey = (igmkey-1)*Nr + k
299  #ifdef GM_NON_UNITY_DIAGONAL  #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  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  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  CADJ STORE Kwz(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
# Line 244  C-    express the Tensor in term of Diff Line 309  C-    express the Tensor in term of Diff
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 266  C     Gradient of Sigma at U points Line 331  C     Gradient of Sigma at U points
331          dSigmaDy(i,j)=op25*( 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)=op25*( 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)*maskp1       &          *_maskW(i,j,k,bi,bj)
337         ENDDO         ENDDO
338        ENDDO        ENDDO
339    
340  #ifdef ALLOW_AUTODIFF_TAMC  #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  CADJ STORE dSigmaDx(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
343  CADJ STORE dSigmaDy(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDy(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
344  CADJ STORE dsigmadrreal(:,:)   = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDr(:,:)   = comlev1_bibj_k, key=kkey, byte=isbyte
345  #endif /* ALLOW_AUTODIFF_TAMC */  #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),K,  
      U             SlopeX, SlopeY,  
      U             dSigmaDx, dSigmaDy,  
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
# Line 300  C     Calculate slopes for use in tensor Line 375  C     Calculate slopes for use in tensor
375           ENDDO           ENDDO
376          ENDDO          ENDDO
377  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
378  # ifndef GM_TAPER_ORIG_CLIPPING  # ifdef GM_EXCLUDE_CLIPPING
379  CADJ STORE Kux(:,:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE Kux(:,:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte
380  # endif  # endif
381  #endif  #endif
# Line 339  C     Gradient of Sigma at V points Line 414  C     Gradient of Sigma at V points
414       &          *_maskS(i,j,k,bi,bj)       &          *_maskS(i,j,k,bi,bj)
415          dSigmaDy(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)=op25*( 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)*maskp1       &          *_maskS(i,j,k,bi,bj)
420         ENDDO         ENDDO
421        ENDDO        ENDDO
422    
423  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
424  CADJ STORE dSigmaDx(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDx(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
425  CADJ STORE dSigmaDy(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDy(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
426  CADJ STORE dsigmadrreal(:,:)   = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDr(:,:)   = comlev1_bibj_k, key=kkey, byte=isbyte
427  #endif /* ALLOW_AUTODIFF_TAMC */  #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),K,  
      U             SlopeX, SlopeY,  
      U             dSigmaDx, dSigmaDy,  
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
# Line 373  C     Calculate slopes for use in tensor Line 456  C     Calculate slopes for use in tensor
456           ENDDO           ENDDO
457          ENDDO          ENDDO
458  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
459  # ifndef GM_TAPER_ORIG_CLIPPING  # ifdef GM_EXCLUDE_CLIPPING
460  CADJ STORE Kvy(:,:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE Kvy(:,:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte
461  # endif  # endif
462  #endif  #endif
# Line 406  CADJ STORE taperFct(:,:)     = comlev1_b Line 489  CADJ STORE taperFct(:,:)     = comlev1_b
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 430  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           CALL GMREDI_DIAGNOSTICS_DRIVER(bi,bj,myThid)
540          ENDIF
541    #endif /* ALLOW_DIAGNOSTICS */
542    
543  #endif /* ALLOW_GMREDI */  #endif /* ALLOW_GMREDI */
544    
545        RETURN        RETURN
# Line 453  C     \================================= Line 559  C     \=================================
559    
560  C     == Global variables ==  C     == Global variables ==
561  #include "SIZE.h"  #include "SIZE.h"
 #include "GRID.h"  
 #include "DYNVARS.h"  
562  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "PARAMS.h"  
563  #include "GMREDI.h"  #include "GMREDI.h"
564    
565  C     == Routine arguments ==  C     == Routine arguments ==
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.21
  ViewVC Help
Powered by ViewVC 1.1.22