/[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.25 by heimbach, Wed Feb 7 00:01:15 2007 UTC revision 1.26 by jmc, Thu May 24 22:34:38 2007 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C $Name$  C $Name$
3    
4  #include "GMREDI_OPTIONS.h"  #include "GMREDI_OPTIONS.h"
5    #undef OLD_VISBECK_CALC
6    
7  CStartOfInterface  CStartOfInterface
8        SUBROUTINE GMREDI_CALC_TENSOR(        SUBROUTINE GMREDI_CALC_TENSOR(
# Line 56  C     == Local variables == Line 57  C     == Local variables ==
57        _RL Cspd, LrhoInf, LrhoSup, fCoriLoc        _RL Cspd, LrhoInf, LrhoSup, fCoriLoc
58    
59  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
60    #ifdef OLD_VISBECK_CALC
61        _RL deltaH,zero_rs        _RL deltaH,zero_rs
62        PARAMETER(zero_rs=0.D0)        PARAMETER(zero_rs=0.D0)
63        _RL N2,SN        _RL N2,SN
64        _RL Ssq(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL Ssq(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
65    #else
66          _RL dSigmaH
67          _RL deltaH, integrDepth
68          _RL Sloc, M2loc, SNloc
69    #endif
70  #endif  #endif
71    
72  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
# Line 90  C---+----1----+----2----+----3----+----4 Line 97  C---+----1----+----2----+----3----+----4
97        doDiagRediFlx = .FALSE.        doDiagRediFlx = .FALSE.
98        IF ( useDiagnostics ) THEN        IF ( useDiagnostics ) THEN
99          doDiagRediFlx = DIAGNOSTICS_IS_ON('GM_KuzTz', myThid )          doDiagRediFlx = DIAGNOSTICS_IS_ON('GM_KuzTz', myThid )
100          doDiagRediFlx = doDiagRediFlx .OR.          doDiagRediFlx = doDiagRediFlx .OR.
101       &                  DIAGNOSTICS_IS_ON('GM_KvzTz', myThid )       &                  DIAGNOSTICS_IS_ON('GM_KvzTz', myThid )
102        ENDIF        ENDIF
103  #endif  #endif
104        
105  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
106        DO j=1-Oly,sNy+Oly        DO j=1-Oly,sNy+Oly
107         DO i=1-Olx,sNx+Olx         DO i=1-Olx,sNx+Olx
# Line 192  C-- 1rst loop on k : compute Tensor Coef Line 199  C-- 1rst loop on k : compute Tensor Coef
199         ENDDO         ENDDO
200  #endif  #endif
201    
202        DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
203         DO i=1-Olx+1,sNx+Olx-1          DO i=1-Olx+1,sNx+Olx-1
204  C      Gradient of Sigma at rVel points  C      Gradient of Sigma at rVel points
205          dSigmaDx(i,j)=op25*( sigmaX(i+1, j ,k-1) +sigmaX(i,j,k-1)           dSigmaDx(i,j)=op25*( sigmaX(i+1,j,k-1)+sigmaX(i,j,k-1)
206       &                    +sigmaX(i+1, j , k ) +sigmaX(i,j, k ) )       &                       +sigmaX(i+1,j, k )+sigmaX(i,j, k )
207       &                  *maskC(i,j,k,bi,bj)       &                      )*maskC(i,j,k,bi,bj)
208          dSigmaDy(i,j)=op25*( sigmaY( i ,j+1,k-1) +sigmaY(i,j,k-1)           dSigmaDy(i,j)=op25*( sigmaY(i,j+1,k-1)+sigmaY(i,j,k-1)
209       &                    +sigmaY( i ,j+1, k ) +sigmaY(i,j, k ) )       &                       +sigmaY(i,j+1, k )+sigmaY(i,j, k )
210       &                  *maskC(i,j,k,bi,bj)       &                      )*maskC(i,j,k,bi,bj)
211          dSigmaDr(i,j)=sigmaR(i,j,k)           dSigmaDr(i,j)=sigmaR(i,j,k)
212            ENDDO
213         ENDDO         ENDDO
       ENDDO  
214    
215  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
216  CADJ STORE dSigmaDx(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDx(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
# Line 211  CADJ STORE dSigmaDy(:,:)       = comlev1 Line 218  CADJ STORE dSigmaDy(:,:)       = comlev1
218  CADJ STORE dSigmaDr(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDr(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
219  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
220    
221    #ifdef GM_VISBECK_VARIABLE_K
222    #ifndef OLD_VISBECK_CALC
223           IF ( GM_Visbeck_alpha.GT.0. .AND.
224         &      -rC(k-1).LT.GM_Visbeck_depth ) THEN
225    
226    C--     Depth average of f/sqrt(Ri) = M^2/N^2 * N
227    C       M^2 and N^2 are horizontal & vertical gradient of buoyancy.
228    
229    C       Calculate terms for mean Richardson number which is used
230    C       in the "variable K" parameterisaton:
231    C       compute depth average from surface down to the bottom or
232    C       GM_Visbeck_depth, whatever is the shallower.
233    
234            DO j=1-Oly+1,sNy+Oly-1
235             DO i=1-Olx+1,sNx+Olx-1
236              IF ( maskC(i,j,k,bi,bj).NE.0. ) THEN
237               integrDepth = -rC( kLowC(i,j,bi,bj) )
238    C-      in 2 steps to avoid mix of RS & RL type in min fct. arguments
239               integrDepth = MIN( integrDepth, GM_Visbeck_depth )
240    C       Distance between level center above and the integration depth
241               deltaH = integrDepth + rC(k-1)
242    C       If negative then we are below the integration level
243    C       (cannot be the case with 2 conditions on maskC & -rC(k-1))
244    C       If positive we limit this to the distance from center above
245               deltaH = MIN( deltaH, drC(k) )
246    C       Now we convert deltaH to a non-dimensional fraction
247               deltaH = deltaH/( integrDepth+rC(1) )
248    
249    C--      compute: ( M^2 * S )^1/2   (= M^2 / N since S=M^2/N^2 )
250               dSigmaH = dSigmaDx(i,j)*dSigmaDx(i,j)
251         &             + dSigmaDy(i,j)*dSigmaDy(i,j)
252               IF ( dSigmaH .GT. 0. _d 0 ) THEN
253                 dSigmaH = SQRT( dSigmaH )
254    C-       compute slope, limited by GM_maxSlope:
255                 IF ( -dSigmaDr(i,j).GT.dSigmaH*GM_rMaxSlope ) THEN
256                  Sloc = dSigmaH / ( -dSigmaDr(i,j) )
257                 ELSE
258                  Sloc = GM_maxSlope
259                 ENDIF
260                 M2loc = Gravity*recip_RhoConst*dSigmaH
261                 SNloc = SQRT( Sloc*M2loc )
262               ELSE
263                 SNloc = 0. _d 0
264               ENDIF
265               VisbeckK(i,j,bi,bj) = VisbeckK(i,j,bi,bj)
266         &       +deltaH*GM_Visbeck_alpha
267         &              *GM_Visbeck_length*GM_Visbeck_length*SNloc
268              ENDIF
269             ENDDO
270            ENDDO
271           ENDIF
272    #endif /* ndef OLD_VISBECK_CALC */
273    #endif /* GM_VISBECK_VARIABLE_K */
274    
275  C     Calculate slopes for use in tensor, taper and/or clip  C     Calculate slopes for use in tensor, taper and/or clip
276        CALL GMREDI_SLOPE_LIMIT(         CALL GMREDI_SLOPE_LIMIT(
277       O             SlopeX, SlopeY,       O             SlopeX, SlopeY,
278       O             SlopeSqr, taperFct,       O             SlopeSqr, taperFct,
279       U             dSigmaDr,       U             dSigmaDr,
# Line 220  C     Calculate slopes for use in tensor Line 281  C     Calculate slopes for use in tensor
281       I             ldd97_LrhoC,rF(k),k,       I             ldd97_LrhoC,rF(k),k,
282       I             bi, bj, myThid )       I             bi, bj, myThid )
283    
284        DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
285         DO i=1-Olx+1,sNx+Olx-1          DO i=1-Olx+1,sNx+Olx-1
286    C      Mask Iso-neutral slopes
287  C       Mask Iso-neutral slopes           SlopeX(i,j)=SlopeX(i,j)*maskC(i,j,k,bi,bj)
288          SlopeX(i,j)=SlopeX(i,j)*maskC(i,j,k,bi,bj)           SlopeY(i,j)=SlopeY(i,j)*maskC(i,j,k,bi,bj)
289          SlopeY(i,j)=SlopeY(i,j)*maskC(i,j,k,bi,bj)           SlopeSqr(i,j)=SlopeSqr(i,j)*maskC(i,j,k,bi,bj)
290          SlopeSqr(i,j)=SlopeSqr(i,j)*maskC(i,j,k,bi,bj)          ENDDO
   
291         ENDDO         ENDDO
       ENDDO  
292    
293  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
294  CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
# Line 239  CADJ STORE dSigmaDr(:,:)     = comlev1_b Line 298  CADJ STORE dSigmaDr(:,:)     = comlev1_b
298  CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte
299  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
300    
301        DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
302         DO i=1-Olx+1,sNx+Olx-1          DO i=1-Olx+1,sNx+Olx-1
303    C      Components of Redi/GM tensor
304  C       Components of Redi/GM tensor           Kwx(i,j,k,bi,bj)= SlopeX(i,j)*taperFct(i,j)
305          Kwx(i,j,k,bi,bj)= SlopeX(i,j)*taperFct(i,j)           Kwy(i,j,k,bi,bj)= SlopeY(i,j)*taperFct(i,j)
306          Kwy(i,j,k,bi,bj)= SlopeY(i,j)*taperFct(i,j)           Kwz(i,j,k,bi,bj)= SlopeSqr(i,j)*taperFct(i,j)
         Kwz(i,j,k,bi,bj)= SlopeSqr(i,j)*taperFct(i,j)  
307    
308  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
309    #ifdef OLD_VISBECK_CALC
310    
311  C- note (jmc) : moved here since only used in VISBECK_VARIABLE_K  C- note (jmc) : moved here since only used in VISBECK_VARIABLE_K
312  C           but do not know if *taperFct (or **2 ?) is necessary  C           but do not know if *taperFct (or **2 ?) is necessary
# Line 274  C       Now we convert deltaH to a non-d Line 333  C       Now we convert deltaH to a non-d
333       &      *GM_Visbeck_alpha*GM_Visbeck_length*GM_Visbeck_length*SN       &      *GM_Visbeck_alpha*GM_Visbeck_length*GM_Visbeck_length*SN
334          ENDIF          ENDIF
335    
336    #endif /* OLD_VISBECK_CALC */
337  #endif /* GM_VISBECK_VARIABLE_K */  #endif /* GM_VISBECK_VARIABLE_K */
338            ENDDO
339         ENDDO         ENDDO
       ENDDO  
340    
341  C-- end 1rst loop on vertical level index k  C-- end 1rst loop on vertical level index k
342        ENDDO        ENDDO
# Line 323  CADJ STORE Kwz(:,:,k,bi,bj) = comlev1_bi Line 382  CADJ STORE Kwz(:,:,k,bi,bj) = comlev1_bi
382  #endif  #endif
383    
384  C-    express the Tensor in term of Diffusivity (= m**2 / s )  C-    express the Tensor in term of Diffusivity (= m**2 / s )
385        DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
386         DO i=1-Olx+1,sNx+Olx-1          DO i=1-Olx+1,sNx+Olx-1
387  #ifdef ALLOW_KAPGM_CONTROL  #ifdef ALLOW_KAPGM_CONTROL
388          Kgm_tmp = GM_isopycK + GM_skewflx*kapgm(i,j,k,bi,bj)           Kgm_tmp = GM_isopycK + GM_skewflx*kapgm(i,j,k,bi,bj)
389  #else  #else
390          Kgm_tmp = GM_isopycK + GM_skewflx*GM_background_K           Kgm_tmp = GM_isopycK + GM_skewflx*GM_background_K
391  #endif  #endif
392  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
393       &          + VisbeckK(i,j,bi,bj)*(1. _d 0 + GM_skewflx)           &           + VisbeckK(i,j,bi,bj)*(1. _d 0 + GM_skewflx)
394  #endif  #endif
395          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)
396          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)
397          Kwz(i,j,k,bi,bj)= ( GM_isopycK           Kwz(i,j,k,bi,bj)= ( GM_isopycK
398  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
399       &                    + VisbeckK(i,j,bi,bj)       &                     + VisbeckK(i,j,bi,bj)
400  #endif  #endif
401       &                    )*Kwz(i,j,k,bi,bj)       &                     )*Kwz(i,j,k,bi,bj)
402            ENDDO
403         ENDDO         ENDDO
       ENDDO  
404    
405  #if ( defined (GM_NON_UNITY_DIAGONAL) || defined (GM_EXTRA_DIAGONAL) )  #if ( defined (GM_NON_UNITY_DIAGONAL) || defined (GM_EXTRA_DIAGONAL) )
406    
407  C     Gradient of Sigma at U points  C     Gradient of Sigma at U points
408        DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
409         DO i=1-Olx+1,sNx+Olx-1          DO i=1-Olx+1,sNx+Olx-1
410          dSigmaDx(i,j)=sigmaX(i,j,k)           dSigmaDx(i,j)=sigmaX(i,j,k)
411       &          *_maskW(i,j,k,bi,bj)       &                       *_maskW(i,j,k,bi,bj)
412          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)
413       &                      +sigmaY(i-1, j ,k) +sigmaY(i, j ,k) )       &                       +sigmaY(i-1, j ,k)+sigmaY(i, j ,k)
414       &          *_maskW(i,j,k,bi,bj)       &                      )*_maskW(i,j,k,bi,bj)
415          dSigmaDr(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 )
416       &                  +maskp1*(sigmaR(i-1,j,kp1) +sigmaR(i,j,kp1)) )       &                      +(sigmaR(i-1,j,kp1)+sigmaR(i,j,kp1))*maskp1
417       &          *_maskW(i,j,k,bi,bj)       &                      )*_maskW(i,j,k,bi,bj)
418            ENDDO
419         ENDDO         ENDDO
       ENDDO  
420    
421  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
422  CADJ STORE SlopeSqr(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE SlopeSqr(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
# Line 367  CADJ STORE dSigmaDr(:,:)   = comlev1_bib Line 426  CADJ STORE dSigmaDr(:,:)   = comlev1_bib
426  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
427    
428  C     Calculate slopes for use in tensor, taper and/or clip  C     Calculate slopes for use in tensor, taper and/or clip
429        CALL GMREDI_SLOPE_LIMIT(         CALL GMREDI_SLOPE_LIMIT(
430       O             SlopeX, SlopeY,       O             SlopeX, SlopeY,
431       O             SlopeSqr, taperFct,       O             SlopeSqr, taperFct,
432       U             dSigmaDr,       U             dSigmaDr,
# Line 385  cph) Line 444  cph)
444  cph)  cph)
445    
446  #ifdef GM_NON_UNITY_DIAGONAL  #ifdef GM_NON_UNITY_DIAGONAL
447    c      IF ( GM_nonUnitDiag ) THEN
448          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
449           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
450            Kux(i,j,k,bi,bj) =            Kux(i,j,k,bi,bj) =
# Line 406  CADJ STORE Kux(:,:,k,bi,bj)  = comlev1_b Line 466  CADJ STORE Kux(:,:,k,bi,bj)  = comlev1_b
466            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 )
467           ENDDO           ENDDO
468          ENDDO          ENDDO
469    c      ENDIF
470  #endif /* GM_NON_UNITY_DIAGONAL */  #endif /* GM_NON_UNITY_DIAGONAL */
471    
472  #ifdef GM_EXTRA_DIAGONAL  #ifdef GM_EXTRA_DIAGONAL
# Line 414  CADJ STORE Kux(:,:,k,bi,bj)  = comlev1_b Line 475  CADJ STORE Kux(:,:,k,bi,bj)  = comlev1_b
475  CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
476  CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte
477  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
478        IF (GM_ExtraDiag) THEN         IF (GM_ExtraDiag) THEN
479          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
480           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
481            Kuz(i,j,k,bi,bj) =            Kuz(i,j,k,bi,bj) =
# Line 429  CADJ STORE taperFct(:,:)     = comlev1_b Line 490  CADJ STORE taperFct(:,:)     = comlev1_b
490       &     )*SlopeX(i,j)*taperFct(i,j)       &     )*SlopeX(i,j)*taperFct(i,j)
491           ENDDO           ENDDO
492          ENDDO          ENDDO
493        ENDIF         ENDIF
494  #endif /* GM_EXTRA_DIAGONAL */  #endif /* GM_EXTRA_DIAGONAL */
495    
496  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
497        IF (doDiagRediFlx) THEN         IF (doDiagRediFlx) THEN
498          km1 = MAX(k-1,1)          km1 = MAX(k-1,1)
499          DO j=1,sNy          DO j=1,sNy
500           DO i=1,sNx+1           DO i=1,sNx+1
# Line 467  C-        Vertical gradients interpolate Line 528  C-        Vertical gradients interpolate
528           ENDDO           ENDDO
529          ENDDO          ENDDO
530          CALL DIAGNOSTICS_FILL(tmp1k, 'GM_KuzTz', k,1,2,bi,bj,myThid)          CALL DIAGNOSTICS_FILL(tmp1k, 'GM_KuzTz', k,1,2,bi,bj,myThid)
531        ENDIF         ENDIF
532  #endif /* ALLOW_DIAGNOSTICS */  #endif /* ALLOW_DIAGNOSTICS */
533    
534  C     Gradient of Sigma at V points  C     Gradient of Sigma at V points
535        DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
536         DO i=1-Olx+1,sNx+Olx-1          DO i=1-Olx+1,sNx+Olx-1
537          dSigmaDx(i,j)=op25*( sigmaX(i, j ,k) +sigmaX(i+1, j ,k)           dSigmaDx(i,j)=op25*( sigmaX(i, j ,k) +sigmaX(i+1, j ,k)
538       &                    +sigmaX(i,j-1,k) +sigmaX(i+1,j-1,k) )       &                       +sigmaX(i,j-1,k) +sigmaX(i+1,j-1,k)
539       &          *_maskS(i,j,k,bi,bj)       &                      )*_maskS(i,j,k,bi,bj)
540          dSigmaDy(i,j)=sigmaY(i,j,k)           dSigmaDy(i,j)=sigmaY(i,j,k)
541       &          *_maskS(i,j,k,bi,bj)       &                       *_maskS(i,j,k,bi,bj)
542          dSigmaDr(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 )
543       &                  +maskp1*(sigmaR(i,j-1,kp1) +sigmaR(i,j,kp1)) )       &                      +(sigmaR(i,j-1,kp1)+sigmaR(i,j,kp1))*maskp1
544       &          *_maskS(i,j,k,bi,bj)       &                      )*_maskS(i,j,k,bi,bj)
545            ENDDO
546         ENDDO         ENDDO
       ENDDO  
547    
548  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
549  CADJ STORE dSigmaDx(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDx(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
# Line 491  CADJ STORE dSigmaDr(:,:)   = comlev1_bib Line 552  CADJ STORE dSigmaDr(:,:)   = comlev1_bib
552  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
553    
554  C     Calculate slopes for use in tensor, taper and/or clip  C     Calculate slopes for use in tensor, taper and/or clip
555        CALL GMREDI_SLOPE_LIMIT(         CALL GMREDI_SLOPE_LIMIT(
556       O             SlopeX, SlopeY,       O             SlopeX, SlopeY,
557       O             SlopeSqr, taperFct,       O             SlopeSqr, taperFct,
558       U             dSigmaDr,       U             dSigmaDr,
# Line 508  cph) Line 569  cph)
569  cph)  cph)
570    
571  #ifdef GM_NON_UNITY_DIAGONAL  #ifdef GM_NON_UNITY_DIAGONAL
572    c      IF ( GM_nonUnitDiag ) THEN
573          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
574           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
575            Kvy(i,j,k,bi,bj) =            Kvy(i,j,k,bi,bj) =
# Line 529  CADJ STORE Kvy(:,:,k,bi,bj)  = comlev1_b Line 591  CADJ STORE Kvy(:,:,k,bi,bj)  = comlev1_b
591            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 )
592           ENDDO           ENDDO
593          ENDDO          ENDDO
594    c      ENDIF
595  #endif /* GM_NON_UNITY_DIAGONAL */  #endif /* GM_NON_UNITY_DIAGONAL */
596    
597  #ifdef GM_EXTRA_DIAGONAL  #ifdef GM_EXTRA_DIAGONAL
# Line 537  CADJ STORE Kvy(:,:,k,bi,bj)  = comlev1_b Line 600  CADJ STORE Kvy(:,:,k,bi,bj)  = comlev1_b
600  CADJ STORE SlopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE SlopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
601  CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte
602  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
603        IF (GM_ExtraDiag) THEN         IF (GM_ExtraDiag) THEN
604          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
605           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
606            Kvz(i,j,k,bi,bj) =            Kvz(i,j,k,bi,bj) =
# Line 552  CADJ STORE taperFct(:,:)     = comlev1_b Line 615  CADJ STORE taperFct(:,:)     = comlev1_b
615       &     )*SlopeY(i,j)*taperFct(i,j)       &     )*SlopeY(i,j)*taperFct(i,j)
616           ENDDO           ENDDO
617          ENDDO          ENDDO
618        ENDIF         ENDIF
619  #endif /* GM_EXTRA_DIAGONAL */  #endif /* GM_EXTRA_DIAGONAL */
620    
621  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
622        IF (doDiagRediFlx) THEN         IF (doDiagRediFlx) THEN
623  c       km1 = MAX(k-1,1)  c       km1 = MAX(k-1,1)
624          DO j=1,sNy+1          DO j=1,sNy+1
625           DO i=1,sNx           DO i=1,sNx
# Line 590  C-        Vertical gradients interpolate Line 653  C-        Vertical gradients interpolate
653           ENDDO           ENDDO
654          ENDDO          ENDDO
655          CALL DIAGNOSTICS_FILL(tmp1k, 'GM_KvzTz', k,1,2,bi,bj,myThid)          CALL DIAGNOSTICS_FILL(tmp1k, 'GM_KvzTz', k,1,2,bi,bj,myThid)
656        ENDIF         ENDIF
657  #endif /* ALLOW_DIAGNOSTICS */  #endif /* ALLOW_DIAGNOSTICS */
658    
659  #endif /* GM_NON_UNITY_DIAGONAL || GM_EXTRA_DIAGONAL */  #endif /* GM_NON_UNITY_DIAGONAL || GM_EXTRA_DIAGONAL */
# Line 601  C-- end 2nd loop on vertical level index Line 664  C-- end 2nd loop on vertical level index
664    
665  #ifdef GM_BOLUS_ADVEC  #ifdef GM_BOLUS_ADVEC
666        IF (GM_AdvForm) THEN        IF (GM_AdvForm) THEN
667          CALL GMREDI_CALC_PSI_B(         CALL GMREDI_CALC_PSI_B(
668       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
669       I             sigmaX, sigmaY, sigmaR,       I             sigmaX, sigmaY, sigmaR,
670       I             ldd97_LrhoW, ldd97_LrhoS,       I             ldd97_LrhoW, ldd97_LrhoS,
671       I             myThid )       I             myThid )
672        ENDIF        ENDIF
673  #endif  #endif
674    
Legend:
Removed from v.1.25  
changed lines
  Added in v.1.26
  ViewVC Help
Powered by ViewVC 1.1.22