/[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.11 by mlosch, Wed Sep 25 19:36:50 2002 UTC revision 1.12 by heimbach, Thu Nov 14 22:43:49 2002 UTC
# Line 44  C     == Local variables == Line 44  C     == Local variables ==
44        INTEGER i,j,k,km1,kp1        INTEGER i,j,k,km1,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)
48          _RL dSigmaDy(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
49        _RL dSigmaDrReal(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL dSigmaDrReal(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)
# Line 64  C     == Local variables == Line 66  C     == Local variables ==
66            act3 = myThid - 1            act3 = myThid - 1
67            max3 = nTx*nTy            max3 = nTx*nTy
68            act4 = ikey_dynamics - 1            act4 = ikey_dynamics - 1
69            ikey = (act1 + 1) + act2*max1            igmkey = (act1 + 1) + act2*max1
70       &                      + act3*max1*max2       &                      + act3*max1*max2
71       &                      + act4*max1*max2*max3       &                      + act4*max1*max2*max3
72  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
73    
74    #ifdef GM_VISBECK_VARIABLE_K
75          DO j=1-Oly,sNy+Oly
76           DO i=1-Olx,sNx+Olx
77            VisbeckK(i,j,bi,bj) = 0. _d 0
78           ENDDO
79          ENDDO
80    #endif
81    
82        DO k=2,Nr        DO k=2,Nr
83  C-- 1rst loop on k : compute Tensor Coeff. at W points.  C-- 1rst loop on k : compute Tensor Coeff. at W points.
84         km1 = MAX(1,k-1)         km1 = MAX(1,k-1)
# Line 76  C-- 1rst loop on k : compute Tensor Coef Line 86  C-- 1rst loop on k : compute Tensor Coef
86         IF (k.LE.1) maskm1 = 0. _d 0         IF (k.LE.1) maskm1 = 0. _d 0
87    
88  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
89         kkey = (ikey-1)*Nr + k         kkey = (igmkey-1)*Nr + k
90         DO j=1-Oly,sNy+Oly         DO j=1-Oly,sNy+Oly
91          DO i=1-Olx,sNx+Olx          DO i=1-Olx,sNx+Olx
92           SlopeX(i,j)       = 0. _d 0           SlopeX(i,j)       = 0. _d 0
93           SlopeY(i,j)       = 0. _d 0           SlopeY(i,j)       = 0. _d 0
94             dSigmaDx(i,j)     = 0. _d 0
95             dSigmaDy(i,j)     = 0. _d 0
96           dSigmaDrReal(i,j) = 0. _d 0           dSigmaDrReal(i,j) = 0. _d 0
97           SlopeSqr(i,j)     = 0. _d 0           SlopeSqr(i,j)     = 0. _d 0
98           taperFct(i,j)     = 0. _d 0           taperFct(i,j)     = 0. _d 0
99           Kwx(i,j,k,bi,bj)  = 0. _d 0           Kwx(i,j,k,bi,bj)  = 0. _d 0
100           Kwy(i,j,k,bi,bj)  = 0. _d 0           Kwy(i,j,k,bi,bj)  = 0. _d 0
101           Kwz(i,j,k,bi,bj)  = 0. _d 0           Kwz(i,j,k,bi,bj)  = 0. _d 0
102    # ifdef GM_NON_UNITY_DIAGONAL
103             Kux(i,j,k,bi,bj)  = 0. _d 0
104             Kvy(i,j,k,bi,bj)  = 0. _d 0
105    # endif
106    # ifdef GM_EXTRA_DIAGONAL
107             Kuz(i,j,k,bi,bj)  = 0. _d 0
108             Kvz(i,j,k,bi,bj)  = 0. _d 0
109    # endif
110    # ifdef GM_BOLUS_ADVEC
111             GM_PsiX(i,j,k,bi,bj)  = 0. _d 0
112             GM_PsiY(i,j,k,bi,bj)  = 0. _d 0
113    # endif
114          ENDDO          ENDDO
115         ENDDO         ENDDO
116  #endif  #endif
117    
118        DO j=1-Oly+1,sNy+Oly-1        DO j=1-Oly+1,sNy+Oly-1
119         DO i=1-Olx+1,sNx+Olx-1         DO i=1-Olx+1,sNx+Olx-1
   
120  C      Gradient of Sigma at rVel points  C      Gradient of Sigma at rVel points
121          SlopeX(i,j)=0.25*( sigmaX(i+1, j ,km1) +sigmaX(i,j,km1)          dSigmaDx(i,j)=0.25*( sigmaX(i+1, j ,km1) +sigmaX(i,j,km1)
122       &                    +sigmaX(i+1, j , k ) +sigmaX(i,j, k ) )       &                    +sigmaX(i+1, j , k ) +sigmaX(i,j, k ) )
123       &                  *maskC(i,j,k,bi,bj)*maskm1       &                  *maskC(i,j,k,bi,bj)*maskm1
124          SlopeY(i,j)=0.25*( sigmaY( i ,j+1,km1) +sigmaY(i,j,km1)          dSigmaDy(i,j)=0.25*( sigmaY( i ,j+1,km1) +sigmaY(i,j,km1)
125       &                    +sigmaY( i ,j+1, k ) +sigmaY(i,j, k ) )       &                    +sigmaY( i ,j+1, k ) +sigmaY(i,j, k ) )
126       &                  *maskC(i,j,k,bi,bj)*maskm1       &                  *maskC(i,j,k,bi,bj)*maskm1
127          dSigmaDrReal(i,j)=sigmaR(i,j,k)*maskm1          dSigmaDrReal(i,j)=sigmaR(i,j,k)*maskm1
   
128         ENDDO         ENDDO
129        ENDDO        ENDDO
130    
131  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
132  CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDx(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
133  CADJ STORE SlopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDy(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
134  CADJ STORE dsigmadrreal(:,:) = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dsigmadrreal(:,:)   = comlev1_bibj_k, key=kkey, byte=isbyte
135  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
136    
137  C     Calculate slopes for use in tensor, taper and/or clip  C     Calculate slopes for use in tensor, taper and/or clip
138        CALL GMREDI_SLOPE_LIMIT(        CALL GMREDI_SLOPE_LIMIT(
139       U             dSigmadRReal,       U             dSigmadRReal,
140       I             rF(K),       I             rF(K),K,
141       U             SlopeX, SlopeY,       U             SlopeX, SlopeY,
142         U             dSigmaDx, dSigmaDy,
143       O             SlopeSqr, taperFct,       O             SlopeSqr, taperFct,
144       I             bi, bj, myThid )       I             bi, bj, myThid )
145    
# Line 132  C       Mask Iso-neutral slopes Line 155  C       Mask Iso-neutral slopes
155        ENDDO        ENDDO
156    
157  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
 CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  
 CADJ STORE SlopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  
158  CADJ STORE SlopeSqr(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE SlopeSqr(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte
159  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
160    
# Line 182  C-- end 1rst loop on vertical level inde Line 203  C-- end 1rst loop on vertical level inde
203    
204    
205  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
206    #ifdef ALLOW_AUTODIFF_TAMC
207    CADJ STORE VisbeckK(:,:,bi,bj) = comlev1_bibj, key=igmkey, byte=isbyte
208    #endif
209        IF ( GM_Visbeck_alpha.NE.0. ) THEN        IF ( GM_Visbeck_alpha.NE.0. ) THEN
210  C-     Limit range that KapGM can take  C-     Limit range that KapGM can take
211         DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
# Line 206  C-- 2nd loop on k : compute Tensor Coeff Line 230  C-- 2nd loop on k : compute Tensor Coeff
230         maskp1 = 1. _d 0         maskp1 = 1. _d 0
231         IF (k.GE.Nr) maskp1 = 0. _d 0         IF (k.GE.Nr) maskp1 = 0. _d 0
232    
233    #ifdef ALLOW_AUTODIFF_TAMC
234           kkey = (igmkey-1)*Nr + k
235    #ifdef GM_NON_UNITY_DIAGONAL
236    CADJ STORE Kwx(:,:,k,bi,bj) = comlev1_bibj, key=kkey, byte=isbyte
237    CADJ STORE Kwy(:,:,k,bi,bj) = comlev1_bibj, key=kkey, byte=isbyte
238    CADJ STORE Kwz(:,:,k,bi,bj) = comlev1_bibj, key=kkey, byte=isbyte
239    #endif
240    #endif
241    
242  C-    express the Tensor in term of Diffusivity (= m**2 / s )  C-    express the Tensor in term of Diffusivity (= m**2 / s )
243        DO j=1-Oly+1,sNy+Oly-1        DO j=1-Oly+1,sNy+Oly-1
244         DO i=1-Olx+1,sNx+Olx-1         DO i=1-Olx+1,sNx+Olx-1
# Line 228  C-    express the Tensor in term of Diff Line 261  C-    express the Tensor in term of Diff
261  C     Gradient of Sigma at U points  C     Gradient of Sigma at U points
262        DO j=1-Oly+1,sNy+Oly-1        DO j=1-Oly+1,sNy+Oly-1
263         DO i=1-Olx+1,sNx+Olx-1         DO i=1-Olx+1,sNx+Olx-1
264          SlopeX(i,j)=sigmaX(i,j,k)          dSigmaDx(i,j)=sigmaX(i,j,k)
265       &          *_maskW(i,j,k,bi,bj)       &          *_maskW(i,j,k,bi,bj)
266          SlopeY(i,j)=0.25*( sigmaY(i-1,j+1,k) +sigmaY(i,j+1,k)          dSigmaDy(i,j)=0.25*( sigmaY(i-1,j+1,k) +sigmaY(i,j+1,k)
267       &                    +sigmaY(i-1, j ,k) +sigmaY(i, j ,k) )       &                      +sigmaY(i-1, j ,k) +sigmaY(i, j ,k) )
268       &          *_maskW(i,j,k,bi,bj)       &          *_maskW(i,j,k,bi,bj)
269          dSigmaDrReal(i,j)=0.25*( sigmaR(i-1,j, k ) +sigmaR(i,j, k )          dSigmaDrReal(i,j)=0.25*( sigmaR(i-1,j, k ) +sigmaR(i,j, k )
270       &                  +maskp1*(sigmaR(i-1,j,kp1) +sigmaR(i,j,kp1)) )       &                  +maskp1*(sigmaR(i-1,j,kp1) +sigmaR(i,j,kp1)) )
# Line 239  C     Gradient of Sigma at U points Line 272  C     Gradient of Sigma at U points
272         ENDDO         ENDDO
273        ENDDO        ENDDO
274    
275    #ifdef ALLOW_AUTODIFF_TAMC
276    CADJ STORE dSigmaDx(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
277    CADJ STORE dSigmaDy(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
278    CADJ STORE dsigmadrreal(:,:)   = comlev1_bibj_k, key=kkey, byte=isbyte
279    #endif /* ALLOW_AUTODIFF_TAMC */
280    
281  C     Calculate slopes for use in tensor, taper and/or clip  C     Calculate slopes for use in tensor, taper and/or clip
282        CALL GMREDI_SLOPE_LIMIT(        CALL GMREDI_SLOPE_LIMIT(
283       U             dSigmadRReal,       U             dSigmadRReal,
284       I             rF(K),       I             rF(K),K,
285       U             SlopeX, SlopeY,       U             SlopeX, SlopeY,
286         U             dSigmaDx, dSigmaDy,
287       O             SlopeSqr, taperFct,       O             SlopeSqr, taperFct,
288       I             bi, bj, myThid )       I             bi, bj, myThid )
289    
# Line 259  C     Calculate slopes for use in tensor Line 299  C     Calculate slopes for use in tensor
299       &     *taperFct(i,j)       &     *taperFct(i,j)
300           ENDDO           ENDDO
301          ENDDO          ENDDO
302    #ifdef ALLOW_AUTODIFF_TAMC
303    # ifndef GM_TAPER_ORIG_CLIPPING
304    CADJ STORE Kux(:,:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte
305    # endif
306    #endif
307          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
308           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
309            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 312  C     Calculate slopes for use in tensor
312  #endif /* GM_NON_UNITY_DIAGONAL */  #endif /* GM_NON_UNITY_DIAGONAL */
313    
314  #ifdef GM_EXTRA_DIAGONAL  #ifdef GM_EXTRA_DIAGONAL
315    
316    #ifdef ALLOW_AUTODIFF_TAMC
317    CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
318    CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte
319    #endif /* ALLOW_AUTODIFF_TAMC */
320        IF (GM_ExtraDiag) THEN        IF (GM_ExtraDiag) THEN
321          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
322           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
# Line 284  C     Calculate slopes for use in tensor Line 334  C     Calculate slopes for use in tensor
334  C     Gradient of Sigma at V points  C     Gradient of Sigma at V points
335        DO j=1-Oly+1,sNy+Oly-1        DO j=1-Oly+1,sNy+Oly-1
336         DO i=1-Olx+1,sNx+Olx-1         DO i=1-Olx+1,sNx+Olx-1
337          SlopeX(i,j)=0.25*( sigmaX(i, j ,k) +sigmaX(i+1, j ,k)          dSigmaDx(i,j)=0.25*( sigmaX(i, j ,k) +sigmaX(i+1, j ,k)
338       &                    +sigmaX(i,j-1,k) +sigmaX(i+1,j-1,k) )       &                    +sigmaX(i,j-1,k) +sigmaX(i+1,j-1,k) )
339       &          *_maskS(i,j,k,bi,bj)       &          *_maskS(i,j,k,bi,bj)
340          SlopeY(i,j)=sigmaY(i,j,k)          dSigmaDy(i,j)=sigmaY(i,j,k)
341       &          *_maskS(i,j,k,bi,bj)       &          *_maskS(i,j,k,bi,bj)
342          dSigmaDrReal(i,j)=0.25*( sigmaR(i,j-1, k ) +sigmaR(i,j, k )          dSigmaDrReal(i,j)=0.25*( sigmaR(i,j-1, k ) +sigmaR(i,j, k )
343       &                  +maskp1*(sigmaR(i,j-1,kp1) +sigmaR(i,j,kp1)) )       &                  +maskp1*(sigmaR(i,j-1,kp1) +sigmaR(i,j,kp1)) )
# Line 295  C     Gradient of Sigma at V points Line 345  C     Gradient of Sigma at V points
345         ENDDO         ENDDO
346        ENDDO        ENDDO
347    
348    #ifdef ALLOW_AUTODIFF_TAMC
349    CADJ STORE dSigmaDx(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
350    CADJ STORE dSigmaDy(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
351    CADJ STORE dsigmadrreal(:,:)   = comlev1_bibj_k, key=kkey, byte=isbyte
352    #endif /* ALLOW_AUTODIFF_TAMC */
353    
354  C     Calculate slopes for use in tensor, taper and/or clip  C     Calculate slopes for use in tensor, taper and/or clip
355        CALL GMREDI_SLOPE_LIMIT(        CALL GMREDI_SLOPE_LIMIT(
356       U             dSigmadRReal,       U             dSigmadRReal,
357       I             rF(K),       I             rF(K),K,
358       U             SlopeX, SlopeY,       U             SlopeX, SlopeY,
359         U             dSigmaDx, dSigmaDy,
360       O             SlopeSqr, taperFct,       O             SlopeSqr, taperFct,
361       I             bi, bj, myThid )       I             bi, bj, myThid )
362    
# Line 315  C     Calculate slopes for use in tensor Line 372  C     Calculate slopes for use in tensor
372       &     *taperFct(i,j)       &     *taperFct(i,j)
373           ENDDO           ENDDO
374          ENDDO          ENDDO
375    #ifdef ALLOW_AUTODIFF_TAMC
376    # ifndef GM_TAPER_ORIG_CLIPPING
377    CADJ STORE Kvy(:,:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte
378    # endif
379    #endif
380          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
381           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
382            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 385  C     Calculate slopes for use in tensor
385  #endif /* GM_NON_UNITY_DIAGONAL */  #endif /* GM_NON_UNITY_DIAGONAL */
386    
387  #ifdef GM_EXTRA_DIAGONAL  #ifdef GM_EXTRA_DIAGONAL
388    
389    #ifdef ALLOW_AUTODIFF_TAMC
390    CADJ STORE SlopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
391    CADJ STORE taperFct(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte
392    #endif /* ALLOW_AUTODIFF_TAMC */
393        IF (GM_ExtraDiag) THEN        IF (GM_ExtraDiag) THEN
394          DO j=1-Oly+1,sNy+Oly-1          DO j=1-Oly+1,sNy+Oly-1
395           DO i=1-Olx+1,sNx+Olx-1           DO i=1-Olx+1,sNx+Olx-1
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22