/[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.26 by jmc, Thu May 24 22:34:38 2007 UTC revision 1.27 by jmc, Thu Jun 21 01:33:01 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    #ifdef ALLOW_KPP
6    # include "KPP_OPTIONS.h"
7    #endif
8  #undef OLD_VISBECK_CALC  #undef OLD_VISBECK_CALC
9    
10  CStartOfInterface  CBOP
11    C     !ROUTINE: GMREDI_CALC_TENSOR
12    C     !INTERFACE:
13        SUBROUTINE GMREDI_CALC_TENSOR(        SUBROUTINE GMREDI_CALC_TENSOR(
14       I             bi, bj, iMin, iMax, jMin, jMax,       I             iMin, iMax, jMin, jMax,
15       I             sigmaX, sigmaY, sigmaR,       I             sigmaX, sigmaY, sigmaR,
16       I             myThid )       I             bi, bj, myTime, myIter, myThid )
17  C     /==========================================================\  
18  C     | SUBROUTINE GMREDI_CALC_TENSOR                            |  C     !DESCRIPTION: \bv
19  C     | o Calculate tensor elements for GM/Redi tensor.          |  C     *==========================================================*
20  C     |==========================================================|  C     | SUBROUTINE GMREDI_CALC_TENSOR
21  C     \==========================================================/  C     | o Calculate tensor elements for GM/Redi tensor.
22    C     *==========================================================*
23    C     *==========================================================*
24    C     \ev
25    
26    C     !USES:
27        IMPLICIT NONE        IMPLICIT NONE
28    
29  C     == Global variables ==  C     == Global variables ==
# Line 24  C     == Global variables == Line 34  C     == Global variables ==
34  #include "PARAMS.h"  #include "PARAMS.h"
35  #include "GMREDI.h"  #include "GMREDI.h"
36  #include "GMREDI_TAVE.h"  #include "GMREDI_TAVE.h"
37    #ifdef ALLOW_KPP
38    # include "KPP.h"
39    #endif
40    
41  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
42  #include "tamc.h"  #include "tamc.h"
43  #include "tamc_keys.h"  #include "tamc_keys.h"
44  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
45    
46    C     !INPUT/OUTPUT PARAMETERS:
47  C     == Routine arguments ==  C     == Routine arguments ==
48    C     bi, bj    :: tile indices
49    C     myTime    :: Current time in simulation
50    C     myIter    :: Current iteration number in simulation
51    C     myThid    :: My Thread Id. number
52  C  C
53          INTEGER iMin,iMax,jMin,jMax
54        _RL sigmaX(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL sigmaX(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
55        _RL sigmaY(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL sigmaY(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
56        _RL sigmaR(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL sigmaR(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
57        INTEGER bi,bj,iMin,iMax,jMin,jMax        INTEGER bi, bj
58          _RL     myTime
59          INTEGER myIter
60        INTEGER myThid        INTEGER myThid
61  CEndOfInterface  CEOP
62    
63  #ifdef ALLOW_GMREDI  #ifdef ALLOW_GMREDI
64    
65    C     !LOCAL VARIABLES:
66  C     == Local variables ==  C     == Local variables ==
67        INTEGER i,j,k,kp1        INTEGER i,j,k,kp1
68        _RL SlopeX(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL SlopeX(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
# Line 56  C     == Local variables == Line 78  C     == Local variables ==
78        _RL ldd97_LrhoS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL ldd97_LrhoS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
79        _RL Cspd, LrhoInf, LrhoSup, fCoriLoc        _RL Cspd, LrhoInf, LrhoSup, fCoriLoc
80    
81          INTEGER kLow_W (1-Olx:sNx+Olx,1-Oly:sNy+Oly)
82          INTEGER kLow_S (1-Olx:sNx+Olx,1-Oly:sNy+Oly)
83          _RL locMixLayer(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
84          _RL baseSlope  (1-Olx:sNx+Olx,1-Oly:sNy+Oly)
85          _RL hTransLay  (1-Olx:sNx+Olx,1-Oly:sNy+Oly)
86          _RL recipLambda(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
87    
88  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
89  #ifdef OLD_VISBECK_CALC  #ifdef OLD_VISBECK_CALC
90        _RL deltaH,zero_rs        _RL deltaH,zero_rs
# Line 111  C---+----1----+----2----+----3----+----4 Line 140  C---+----1----+----2----+----3----+----4
140  #endif  #endif
141    
142  C--   set ldd97_Lrho (for tapering scheme ldd97):  C--   set ldd97_Lrho (for tapering scheme ldd97):
143        IF (GM_taper_scheme.EQ.'ldd97') THEN        IF ( GM_taper_scheme.EQ.'ldd97' .OR.
144         &     GM_taper_scheme.EQ.'fm07' ) THEN
145         Cspd = 2. _d 0         Cspd = 2. _d 0
146         LrhoInf = 15. _d 3         LrhoInf = 15. _d 3
147         LrhoSup = 100. _d 3         LrhoSup = 100. _d 3
# Line 128  C-     Tracer point location (center): Line 158  C-     Tracer point location (center):
158         ENDDO         ENDDO
159  C-     U point location (West):  C-     U point location (West):
160         DO j=1-Oly,sNy+Oly         DO j=1-Oly,sNy+Oly
161            kLow_W(1-Olx,j) = 0
162          ldd97_LrhoW(1-Olx,j) = LrhoSup          ldd97_LrhoW(1-Olx,j) = LrhoSup
163          DO i=1-Olx+1,sNx+Olx          DO i=1-Olx+1,sNx+Olx
164             kLow_W(i,j) = MIN(kLowC(i-1,j,bi,bj),kLowC(i,j,bi,bj))
165           fCoriLoc = op5*(fCori(i-1,j,bi,bj)+fCori(i,j,bi,bj))           fCoriLoc = op5*(fCori(i-1,j,bi,bj)+fCori(i,j,bi,bj))
166           IF (fCoriLoc.NE.0.) THEN           IF (fCoriLoc.NE.0.) THEN
167             ldd97_LrhoW(i,j) = Cspd/ABS(fCoriLoc)             ldd97_LrhoW(i,j) = Cspd/ABS(fCoriLoc)
# Line 141  C-     U point location (West): Line 173  C-     U point location (West):
173         ENDDO         ENDDO
174  C-     V point location (South):  C-     V point location (South):
175         DO i=1-Olx+1,sNx+Olx         DO i=1-Olx+1,sNx+Olx
176             kLow_S(i,1-Oly) = 0
177           ldd97_LrhoS(i,1-Oly) = LrhoSup           ldd97_LrhoS(i,1-Oly) = LrhoSup
178         ENDDO         ENDDO
179         DO j=1-Oly+1,sNy+Oly         DO j=1-Oly+1,sNy+Oly
180          DO i=1-Olx,sNx+Olx          DO i=1-Olx,sNx+Olx
181             kLow_S(i,j) = MIN(kLowC(i,j-1,bi,bj),kLowC(i,j,bi,bj))
182           fCoriLoc = op5*(fCori(i,j-1,bi,bj)+fCori(i,j,bi,bj))           fCoriLoc = op5*(fCori(i,j-1,bi,bj)+fCori(i,j,bi,bj))
183           IF (fCoriLoc.NE.0.) THEN           IF (fCoriLoc.NE.0.) THEN
184             ldd97_LrhoS(i,j) = Cspd/ABS(fCoriLoc)             ldd97_LrhoS(i,j) = Cspd/ABS(fCoriLoc)
# Line 164  C-    Just initialize to zero (not use a Line 198  C-    Just initialize to zero (not use a
198          ENDDO          ENDDO
199         ENDDO         ENDDO
200        ENDIF        ENDIF
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
201    
202        DO k=2,Nr  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
203  C-- 1rst loop on k : compute Tensor Coeff. at W points.  C-- 1rst loop on k : compute Tensor Coeff. at W points.
204    
205    #ifdef ALLOW_KPP
206          IF ( useKPP ) THEN
207           DO j=1-Oly,sNy+Oly
208            DO i=1-Olx,sNx+Olx
209             locMixLayer(i,j) = KPPhbl(i,j,bi,bj)
210            ENDDO
211           ENDDO
212          ELSE
213    #else
214          IF ( .TRUE. ) THEN
215    #endif
216           DO j=1-Oly,sNy+Oly
217            DO i=1-Olx,sNx+Olx
218             locMixLayer(i,j) = hMixLayer(i,j,bi,bj)
219            ENDDO
220           ENDDO
221          ENDIF
222          DO j=1-Oly,sNy+Oly
223           DO i=1-Olx,sNx+Olx
224             hTransLay(i,j) = R_low(i,j,bi,bj)
225             baseSlope(i,j) =  0.
226             recipLambda(i,j)= 0.
227           ENDDO
228          ENDDO
229    
230          DO k=Nr,2,-1
231    
232  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
233         kkey = (igmkey-1)*Nr + k         kkey = (igmkey-1)*Nr + k
234         DO j=1-Oly,sNy+Oly         DO j=1-Oly,sNy+Oly
# Line 276  C     Calculate slopes for use in tensor Line 336  C     Calculate slopes for use in tensor
336         CALL GMREDI_SLOPE_LIMIT(         CALL GMREDI_SLOPE_LIMIT(
337       O             SlopeX, SlopeY,       O             SlopeX, SlopeY,
338       O             SlopeSqr, taperFct,       O             SlopeSqr, taperFct,
339         U             hTransLay, baseSlope, recipLambda,
340       U             dSigmaDr,       U             dSigmaDr,
341       I             dSigmaDx, dSigmaDy,       I             dSigmaDx, dSigmaDy,
342       I             ldd97_LrhoC,rF(k),k,       I             ldd97_LrhoC, locMixLayer, rF,
343       I             bi, bj, myThid )       I             kLowC(1-Olx,1-Oly,bi,bj),
344         I             k, bi, bj, myTime, myIter, myThid )
345    
346         DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
347          DO i=1-Olx+1,sNx+Olx-1          DO i=1-Olx+1,sNx+Olx-1
# Line 298  CADJ STORE dSigmaDr(:,:)     = comlev1_b Line 360  CADJ STORE dSigmaDr(:,:)     = comlev1_b
360  CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte
361  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
362    
363    C      Components of Redi/GM tensor
364         DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
365          DO i=1-Olx+1,sNx+Olx-1          DO i=1-Olx+1,sNx+Olx-1
366  C      Components of Redi/GM tensor            Kwx(i,j,k,bi,bj)= SlopeX(i,j)*taperFct(i,j)
367           Kwx(i,j,k,bi,bj)= SlopeX(i,j)*taperFct(i,j)            Kwy(i,j,k,bi,bj)= SlopeY(i,j)*taperFct(i,j)
368           Kwy(i,j,k,bi,bj)= SlopeY(i,j)*taperFct(i,j)            Kwz(i,j,k,bi,bj)= SlopeSqr(i,j)*taperFct(i,j)
369           Kwz(i,j,k,bi,bj)= SlopeSqr(i,j)*taperFct(i,j)          ENDDO
370           ENDDO
371    
372  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
373  #ifdef OLD_VISBECK_CALC  #ifdef OLD_VISBECK_CALC
374           DO j=1-Oly+1,sNy+Oly-1
375            DO i=1-Olx+1,sNx+Olx-1
376    
377  C- note (jmc) : moved here since only used in VISBECK_VARIABLE_K  C- note (jmc) : moved here since only used in VISBECK_VARIABLE_K
378  C           but do not know if *taperFct (or **2 ?) is necessary  C           but do not know if *taperFct (or **2 ?) is necessary
379          Ssq(i,j)=SlopeSqr(i,j)*taperFct(i,j)          Ssq(i,j)=SlopeSqr(i,j)*taperFct(i,j)
380    
381  C--     Depth average of M^2/N^2 * N  C--     Depth average of M^2/N^2 * N
# Line 333  C       Now we convert deltaH to a non-d Line 399  C       Now we convert deltaH to a non-d
399       &      *GM_Visbeck_alpha*GM_Visbeck_length*GM_Visbeck_length*SN       &      *GM_Visbeck_alpha*GM_Visbeck_length*GM_Visbeck_length*SN
400          ENDIF          ENDIF
401    
 #endif /* OLD_VISBECK_CALC */  
 #endif /* GM_VISBECK_VARIABLE_K */  
402          ENDDO          ENDDO
403         ENDDO         ENDDO
404    #endif /* OLD_VISBECK_CALC */
405    #endif /* GM_VISBECK_VARIABLE_K */
406    
407  C-- end 1rst loop on vertical level index k  C-- end 1rst loop on vertical level index k
408        ENDDO        ENDDO
# Line 346  C-- end 1rst loop on vertical level inde Line 412  C-- end 1rst loop on vertical level inde
412  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
413  CADJ STORE VisbeckK(:,:,bi,bj) = comlev1_bibj, key=igmkey, byte=isbyte  CADJ STORE VisbeckK(:,:,bi,bj) = comlev1_bibj, key=igmkey, byte=isbyte
414  #endif  #endif
415        IF ( GM_Visbeck_alpha.NE.0. ) THEN        IF ( GM_Visbeck_alpha.GT.0. ) THEN
416  C-     Limit range that KapGM can take  C-     Limit range that KapGM can take
417         DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
418          DO i=1-Olx+1,sNx+Olx-1          DO i=1-Olx+1,sNx+Olx-1
# Line 362  CADJ STORE VisbeckK(:,:,bi,bj) = comlev1 Line 428  CADJ STORE VisbeckK(:,:,bi,bj) = comlev1
428  cph)  cph)
429  #endif /* GM_VISBECK_VARIABLE_K */  #endif /* GM_VISBECK_VARIABLE_K */
430    
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
   
 C-- 2nd loop on k : compute Tensor Coeff. at U,V levels.  
       DO k=1,Nr  
        kp1 = MIN(Nr,k+1)  
        maskp1 = 1. _d 0  
        IF (k.GE.Nr) maskp1 = 0. _d 0  
   
431  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
432         kkey = (igmkey-1)*Nr + k         kkey = (igmkey-1)*Nr + k
433  #if (defined (GM_NON_UNITY_DIAGONAL) || \  #if (defined (GM_NON_UNITY_DIAGONAL) || \
# Line 382  CADJ STORE Kwz(:,:,k,bi,bj) = comlev1_bi Line 439  CADJ STORE Kwz(:,:,k,bi,bj) = comlev1_bi
439  #endif  #endif
440    
441  C-    express the Tensor in term of Diffusivity (= m**2 / s )  C-    express the Tensor in term of Diffusivity (= m**2 / s )
442          DO k=1,Nr
443         DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
444          DO i=1-Olx+1,sNx+Olx-1          DO i=1-Olx+1,sNx+Olx-1
445  #ifdef ALLOW_KAPGM_CONTROL  #ifdef ALLOW_KAPGM_CONTROL
# Line 401  C-    express the Tensor in term of Diff Line 459  C-    express the Tensor in term of Diff
459       &                     )*Kwz(i,j,k,bi,bj)       &                     )*Kwz(i,j,k,bi,bj)
460          ENDDO          ENDDO
461         ENDDO         ENDDO
462          ENDDO
463    
464    #ifdef ALLOW_DIAGNOSTICS
465          IF ( useDiagnostics .AND. GM_taper_scheme.EQ.'fm07' ) THEN
466           CALL DIAGNOSTICS_FILL( hTransLay, 'GM_hTrsL', 0,1,2,bi,bj,myThid)
467           CALL DIAGNOSTICS_FILL( baseSlope, 'GM_baseS', 0,1,2,bi,bj,myThid)
468           CALL DIAGNOSTICS_FILL(recipLambda,'GM_rLamb', 0,1,2,bi,bj,myThid)
469          ENDIF
470    #endif /* ALLOW_DIAGNOSTICS */
471    
472    
473  #if ( defined (GM_NON_UNITY_DIAGONAL) || defined (GM_EXTRA_DIAGONAL) )  #if ( defined (GM_NON_UNITY_DIAGONAL) || defined (GM_EXTRA_DIAGONAL) )
474    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
475    C-- 2nd  k loop : compute Tensor Coeff. at U point
476    
477    #ifdef ALLOW_KPP
478          IF ( useKPP ) THEN
479           DO j=1-Oly,sNy+Oly
480            DO i=2-Olx,sNx+Olx
481             locMixLayer(i,j) = ( KPPhbl(i-1,j,bi,bj)
482         &                      + KPPhbl( i ,j,bi,bj) )*op5
483            ENDDO
484           ENDDO
485          ELSE
486    #else
487          IF ( .TRUE. ) THEN
488    #endif
489           DO j=1-Oly,sNy+Oly
490            DO i=2-Olx,sNx+Olx
491             locMixLayer(i,j) = ( hMixLayer(i-1,j,bi,bj)
492         &                      + hMixLayer( i ,j,bi,bj) )*op5
493            ENDDO
494           ENDDO
495          ENDIF
496          DO j=1-Oly,sNy+Oly
497           DO i=1-Olx,sNx+Olx
498             hTransLay(i,j) =  0.
499             baseSlope(i,j) =  0.
500             recipLambda(i,j)= 0.
501           ENDDO
502           DO i=2-Olx,sNx+Olx
503             hTransLay(i,j) = MAX( R_low(i-1,j,bi,bj), R_low(i,j,bi,bj) )
504           ENDDO
505          ENDDO
506    
507          DO k=Nr,1,-1
508           kp1 = MIN(Nr,k+1)
509           maskp1 = 1. _d 0
510           IF (k.GE.Nr) maskp1 = 0. _d 0
511    
512  C     Gradient of Sigma at U points  C     Gradient of Sigma at U points
513         DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
# Line 429  C     Calculate slopes for use in tensor Line 534  C     Calculate slopes for use in tensor
534         CALL GMREDI_SLOPE_LIMIT(         CALL GMREDI_SLOPE_LIMIT(
535       O             SlopeX, SlopeY,       O             SlopeX, SlopeY,
536       O             SlopeSqr, taperFct,       O             SlopeSqr, taperFct,
537         U             hTransLay, baseSlope, recipLambda,
538       U             dSigmaDr,       U             dSigmaDr,
539       I             dSigmaDx, dSigmaDy,       I             dSigmaDx, dSigmaDy,
540       I             ldd97_LrhoW,rC(k),k,       I             ldd97_LrhoW, locMixLayer, rC,
541       I             bi, bj, myThid )       I             kLow_W,
542         I             k, bi, bj, myTime, myIter, myThid )
543    
544  cph( NEW  cph( NEW
545  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 452  c      IF ( GM_nonUnitDiag ) THEN Line 559  c      IF ( GM_nonUnitDiag ) THEN
559  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
560       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))
561  #endif  #endif
562       &     )       &     )*taperFct(i,j)
      &     *taperFct(i,j)  
563           ENDDO           ENDDO
564          ENDDO          ENDDO
565  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 475  c      ENDIF Line 581  c      ENDIF
581  CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
582  CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte
583  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
584         IF (GM_ExtraDiag) THEN         IF ( GM_ExtraDiag ) THEN
585          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
586           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
587            Kuz(i,j,k,bi,bj) =            Kuz(i,j,k,bi,bj) =
# Line 531  C-        Vertical gradients interpolate Line 637  C-        Vertical gradients interpolate
637         ENDIF         ENDIF
638  #endif /* ALLOW_DIAGNOSTICS */  #endif /* ALLOW_DIAGNOSTICS */
639    
640    C-- end 2nd  loop on vertical level index k
641          ENDDO
642    
643    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
644    C-- 3rd  k loop : compute Tensor Coeff. at V point
645    
646    #ifdef ALLOW_KPP
647          IF ( useKPP ) THEN
648           DO j=2-Oly,sNy+Oly
649            DO i=1-Olx,sNx+Olx
650             locMixLayer(i,j) = ( KPPhbl(i,j-1,bi,bj)
651         &                      + KPPhbl(i, j ,bi,bj) )*op5
652            ENDDO
653           ENDDO
654          ELSE
655    #else
656          IF ( .TRUE. ) THEN
657    #endif
658           DO j=2-Oly,sNy+Oly
659            DO i=1-Olx,sNx+Olx
660             locMixLayer(i,j) = ( hMixLayer(i,j-1,bi,bj)
661         &                      + hMixLayer(i, j ,bi,bj) )*op5
662            ENDDO
663           ENDDO
664          ENDIF
665          DO j=1-Oly,sNy+Oly
666           DO i=1-Olx,sNx+Olx
667             hTransLay(i,j) =  0.
668             baseSlope(i,j) =  0.
669             recipLambda(i,j)= 0.
670           ENDDO
671          ENDDO
672          DO j=2-Oly,sNy+Oly
673           DO i=1-Olx,sNx+Olx
674             hTransLay(i,j) = MAX( R_low(i,j-1,bi,bj), R_low(i,j,bi,bj) )
675           ENDDO
676          ENDDO
677    
678  C     Gradient of Sigma at V points  C     Gradient of Sigma at V points
679          DO k=Nr,1,-1
680           kp1 = MIN(Nr,k+1)
681           maskp1 = 1. _d 0
682           IF (k.GE.Nr) maskp1 = 0. _d 0
683    
684         DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
685          DO i=1-Olx+1,sNx+Olx-1          DO i=1-Olx+1,sNx+Olx-1
686           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)
# Line 555  C     Calculate slopes for use in tensor Line 704  C     Calculate slopes for use in tensor
704         CALL GMREDI_SLOPE_LIMIT(         CALL GMREDI_SLOPE_LIMIT(
705       O             SlopeX, SlopeY,       O             SlopeX, SlopeY,
706       O             SlopeSqr, taperFct,       O             SlopeSqr, taperFct,
707         U             hTransLay, baseSlope, recipLambda,
708       U             dSigmaDr,       U             dSigmaDr,
709       I             dSigmaDx, dSigmaDy,       I             dSigmaDx, dSigmaDy,
710       I             ldd97_LrhoS,rC(k),k,       I             ldd97_LrhoS, locMixLayer, rC,
711       I             bi, bj, myThid )       I             kLow_S,
712         I             k, bi, bj, myTime, myIter, myThid )
713    
714  cph(  cph(
715  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 577  c      IF ( GM_nonUnitDiag ) THEN Line 728  c      IF ( GM_nonUnitDiag ) THEN
728  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
729       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i,j-1,bi,bj))       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i,j-1,bi,bj))
730  #endif  #endif
731       &     )       &     )*taperFct(i,j)
      &     *taperFct(i,j)  
732           ENDDO           ENDDO
733          ENDDO          ENDDO
734  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 600  c      ENDIF Line 750  c      ENDIF
750  CADJ STORE SlopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE SlopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
751  CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte
752  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
753         IF (GM_ExtraDiag) THEN         IF ( GM_ExtraDiag ) THEN
754          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
755           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
756            Kvz(i,j,k,bi,bj) =            Kvz(i,j,k,bi,bj) =
# Line 656  C-        Vertical gradients interpolate Line 806  C-        Vertical gradients interpolate
806         ENDIF         ENDIF
807  #endif /* ALLOW_DIAGNOSTICS */  #endif /* ALLOW_DIAGNOSTICS */
808    
809  #endif /* GM_NON_UNITY_DIAGONAL || GM_EXTRA_DIAGONAL */  C-- end 3rd  loop on vertical level index k
   
 C-- end 2nd loop on vertical level index k  
810        ENDDO        ENDDO
811    
812    #endif /* GM_NON_UNITY_DIAGONAL || GM_EXTRA_DIAGONAL */
813    
814    
815  #ifdef GM_BOLUS_ADVEC  #ifdef GM_BOLUS_ADVEC
816        IF (GM_AdvForm) THEN        IF (GM_AdvForm) THEN
# Line 716  C--   Time-average Line 866  C--   Time-average
866    
867    
868        SUBROUTINE GMREDI_CALC_TENSOR_DUMMY(        SUBROUTINE GMREDI_CALC_TENSOR_DUMMY(
869       I             bi, bj, iMin, iMax, jMin, jMax,       I             iMin, iMax, jMin, jMax,
870       I             sigmaX, sigmaY, sigmaR,       I             sigmaX, sigmaY, sigmaR,
871       I             myThid )       I             bi, bj, myTime, myIter, myThid )
872  C     /==========================================================\  C     /==========================================================\
873  C     | SUBROUTINE GMREDI_CALC_TENSOR                            |  C     | SUBROUTINE GMREDI_CALC_TENSOR                            |
874  C     | o Calculate tensor elements for GM/Redi tensor.          |  C     | o Calculate tensor elements for GM/Redi tensor.          |
# Line 736  C Line 886  C
886        _RL sigmaX(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL sigmaX(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
887        _RL sigmaY(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL sigmaY(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
888        _RL sigmaR(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL sigmaR(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
889        INTEGER bi,bj,iMin,iMax,jMin,jMax        INTEGER iMin,iMax,jMin,jMax
890          INTEGER bi, bj
891          _RL     myTime
892          INTEGER myIter
893        INTEGER myThid        INTEGER myThid
894  CEndOfInterface  CEndOfInterface
895    
       INTEGER i, j, k  
   
896  #ifdef ALLOW_GMREDI  #ifdef ALLOW_GMREDI
897    
898          INTEGER i, j, k
899    
900        DO k=1,Nr        DO k=1,Nr
901         DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
902          DO i=1-Olx+1,sNx+Olx-1          DO i=1-Olx+1,sNx+Olx-1
Legend:
Removed from v.1.26  
changed lines
  Added in v.1.27
  ViewVC Help
Powered by ViewVC 1.1.22