/[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.9 by jmc, Sun Dec 16 18:54:49 2001 UTC revision 1.10 by heimbach, Sun Mar 24 02:33:16 2002 UTC
# Line 24  C     == Global variables == Line 24  C     == Global variables ==
24  #include "GMREDI.h"  #include "GMREDI.h"
25  #include "GMREDI_DIAGS.h"  #include "GMREDI_DIAGS.h"
26    
27    #ifdef ALLOW_AUTODIFF_TAMC
28    #include "tamc.h"
29    #include "tamc_keys.h"
30    #endif /* ALLOW_AUTODIFF_TAMC */
31    
32  C     == Routine arguments ==  C     == Routine arguments ==
33  C  C
34        _RL sigmaX(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL sigmaX(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
# Line 42  C     == Local variables == Line 47  C     == Local variables ==
47        _RL dSigmaDrReal(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL dSigmaDrReal(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
48        _RL SlopeSqr(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL SlopeSqr(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
49        _RL taperFct(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL taperFct(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
50        _RL maskp1, Kgm_tmp        _RL maskp1, maskm1, Kgm_tmp
51    
52  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
53        _RS deltaH,zero_rs        _RS deltaH,zero_rs
54        PARAMETER(zero_rs=0.)        PARAMETER(zero_rs=0.)
55        _RL N2,SN        _RL N2,SN
56        _RL Ssq        _RL Ssq(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
57  #endif  #endif
58    
59    #ifdef ALLOW_AUTODIFF_TAMC
60              act1 = bi - myBxLo(myThid)
61              max1 = myBxHi(myThid) - myBxLo(myThid) + 1
62              act2 = bj - myByLo(myThid)
63              max2 = myByHi(myThid) - myByLo(myThid) + 1
64              act3 = myThid - 1
65              max3 = nTx*nTy
66              act4 = ikey_dynamics - 1
67              ikey = (act1 + 1) + act2*max1
68         &                      + act3*max1*max2
69         &                      + act4*max1*max2*max3
70    #endif /* ALLOW_AUTODIFF_TAMC */
71    
72        DO k=2,Nr        DO k=2,Nr
73  C-- 1rst loop on k : compute Tensor Coeff. at W points.  C-- 1rst loop on k : compute Tensor Coeff. at W points.
74  c      km1 = MAX(1,k-1)         km1 = MAX(1,k-1)
75           maskm1 = 1. _d 0
76           IF (k.LE.1) maskm1 = 0. _d 0
77    
78  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
79  !HPF$ INDEPENDENT         kkey = (ikey-1)*Nr + k
80           DO j=1-Oly,sNy+Oly
81            DO i=1-Olx,sNx+Olx
82             SlopeX(i,j)       = 0. _d 0
83             SlopeY(i,j)       = 0. _d 0
84             dSigmaDrReal(i,j) = 0. _d 0
85             SlopeSqr(i,j)     = 0. _d 0
86             taperFct(i,j)     = 0. _d 0
87             Kwx(i,j,k,bi,bj)  = 0. _d 0
88             Kwy(i,j,k,bi,bj)  = 0. _d 0
89             Kwz(i,j,k,bi,bj)  = 0. _d 0
90            ENDDO
91           ENDDO
92  #endif  #endif
93    
94        DO j=1-Oly+1,sNy+Oly-1        DO j=1-Oly+1,sNy+Oly-1
 #ifdef ALLOW_AUTODIFF_TAMC  
 !HPF$ INDEPENDENT  
 #endif  
95         DO i=1-Olx+1,sNx+Olx-1         DO i=1-Olx+1,sNx+Olx-1
96    
97  C      Gradient of Sigma at rVel points  C      Gradient of Sigma at rVel points
98          SlopeX(i,j)=0.25*( sigmaX(i+1, j ,k-1) +sigmaX(i,j,k-1)          SlopeX(i,j)=0.25*( sigmaX(i+1, j ,km1) +sigmaX(i,j,km1)
99       &                    +sigmaX(i+1, j , k ) +sigmaX(i,j, k ) )       &                    +sigmaX(i+1, j , k ) +sigmaX(i,j, k ) )
100       &                  *maskC(i,j,k,bi,bj)       &                  *maskC(i,j,k,bi,bj)*maskm1
101          SlopeY(i,j)=0.25*( sigmaY( i ,j+1,k-1) +sigmaY(i,j,k-1)          SlopeY(i,j)=0.25*( sigmaY( i ,j+1,km1) +sigmaY(i,j,km1)
102       &                    +sigmaY( i ,j+1, k ) +sigmaY(i,j, k ) )       &                    +sigmaY( i ,j+1, k ) +sigmaY(i,j, k ) )
103       &                  *maskC(i,j,k,bi,bj)       &                  *maskC(i,j,k,bi,bj)*maskm1
104          dSigmaDrReal(i,j)=sigmaR(i,j,k)          dSigmaDrReal(i,j)=sigmaR(i,j,k)*maskm1
105    
106         ENDDO         ENDDO
107        ENDDO        ENDDO
108    
109    #ifdef ALLOW_AUTODIFF_TAMC
110    CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
111    CADJ STORE SlopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
112    CADJ STORE dsigmadrreal(:,:) = comlev1_bibj_k, key=kkey, byte=isbyte
113    #endif /* ALLOW_AUTODIFF_TAMC */
114    
115  C     Calculate slopes for use in tensor, taper and/or clip  C     Calculate slopes for use in tensor, taper and/or clip
116        CALL GMREDI_SLOPE_LIMIT(        CALL GMREDI_SLOPE_LIMIT(
117       U             dSigmadRReal,       U             dSigmadRReal,
# Line 88  C     Calculate slopes for use in tensor Line 124  C     Calculate slopes for use in tensor
124         DO i=1-Olx+1,sNx+Olx-1         DO i=1-Olx+1,sNx+Olx-1
125    
126  C       Mask Iso-neutral slopes  C       Mask Iso-neutral slopes
127          SlopeX(i,j)=SlopeX(i,j)*maskC(i,j,k,bi,bj)          SlopeX(i,j)=SlopeX(i,j)*maskC(i,j,k,bi,bj)*maskm1
128          SlopeY(i,j)=SlopeY(i,j)*maskC(i,j,k,bi,bj)          SlopeY(i,j)=SlopeY(i,j)*maskC(i,j,k,bi,bj)*maskm1
129          SlopeSqr(i,j)=SlopeSqr(i,j)*maskC(i,j,k,bi,bj)          SlopeSqr(i,j)=SlopeSqr(i,j)*maskC(i,j,k,bi,bj)*maskm1
130  c       Ssq=SlopeX(i,j)*SlopeX(i,j)+SlopeY(i,j)*SlopeY(i,j)  
131           ENDDO
132          ENDDO
133    
134    #ifdef ALLOW_AUTODIFF_TAMC
135    CADJ STORE SlopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
136    CADJ STORE SlopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
137    CADJ STORE SlopeSqr(:,:)     = comlev1_bibj_k, key=kkey, byte=isbyte
138    #endif /* ALLOW_AUTODIFF_TAMC */
139    
140          DO j=1-Oly+1,sNy+Oly-1
141           DO i=1-Olx+1,sNx+Olx-1
142    
143  C       Components of Redi/GM tensor  C       Components of Redi/GM tensor
144          Kwx(i,j,k,bi,bj)= SlopeX(i,j)*taperFct(i,j)          Kwx(i,j,k,bi,bj)= SlopeX(i,j)*taperFct(i,j)
# Line 102  C       Components of Redi/GM tensor Line 149  C       Components of Redi/GM tensor
149    
150  C- note (jmc) : moved here since only used in VISBECK_VARIABLE_K  C- note (jmc) : moved here since only used in VISBECK_VARIABLE_K
151  C           but don't know if *taperFct (or **2 ?) is necessary  C           but don't know if *taperFct (or **2 ?) is necessary
152          Ssq=SlopeSqr(i,j)*taperFct(i,j)          Ssq(i,j)=SlopeSqr(i,j)*taperFct(i,j)
153    
154  C--     Depth average of M^2/N^2 * N  C--     Depth average of M^2/N^2 * N
155    
# Line 118  C       Now we convert deltaH to a non-d Line 165  C       Now we convert deltaH to a non-d
165          deltaH=deltaH/GM_Visbeck_depth          deltaH=deltaH/GM_Visbeck_depth
166    
167          IF (K.eq.2) VisbeckK(i,j,bi,bj)=0.          IF (K.eq.2) VisbeckK(i,j,bi,bj)=0.
168          IF (Ssq.NE.0.) THEN          IF (Ssq(i,j).NE.0.) THEN
169           N2= -Gravity*recip_Rhonil*dSigmaDrReal(i,j)           N2= -Gravity*recip_Rhonil*dSigmaDrReal(i,j)
170           SN=sqrt(Ssq*N2)           SN=sqrt(Ssq(i,j)*N2)
171           VisbeckK(i,j,bi,bj)=VisbeckK(i,j,bi,bj)+deltaH           VisbeckK(i,j,bi,bj)=VisbeckK(i,j,bi,bj)+deltaH
172       &      *GM_Visbeck_alpha*GM_Visbeck_length*GM_Visbeck_length*SN       &      *GM_Visbeck_alpha*GM_Visbeck_length*GM_Visbeck_length*SN
173          ENDIF          ENDIF
# Line 152  C-     Limit range that KapGM can take Line 199  C-     Limit range that KapGM can take
199    
200    
201  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
202    
203  C-- 2nd loop on k : compute Tensor Coeff. at U,V levels.  C-- 2nd loop on k : compute Tensor Coeff. at U,V levels.
204        DO k=1,Nr        DO k=1,Nr
205         kp1 = MIN(Nr,k+1)         kp1 = MIN(Nr,k+1)
# Line 207  C     Calculate slopes for use in tensor Line 255  C     Calculate slopes for use in tensor
255  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
256       &     +0.5*(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))       &     +0.5*(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))
257  #endif  #endif
258       &     )*taperFct(i,j)       &     )
259         &     *taperFct(i,j)
260             ENDDO
261            ENDDO
262            DO j=1-Oly+1,sNy+Oly-1
263             DO i=1-Olx+1,sNx+Olx-1
264            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 )
265           ENDDO           ENDDO
266          ENDDO          ENDDO
# Line 258  C     Calculate slopes for use in tensor Line 311  C     Calculate slopes for use in tensor
311  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
312       &     +0.5*(VisbeckK(i,j,bi,bj)+VisbeckK(i,j-1,bi,bj))       &     +0.5*(VisbeckK(i,j,bi,bj)+VisbeckK(i,j-1,bi,bj))
313  #endif  #endif
314       &     )*taperFct(i,j)       &     )
315         &     *taperFct(i,j)
316             ENDDO
317            ENDDO
318            DO j=1-Oly+1,sNy+Oly-1
319             DO i=1-Olx+1,sNx+Olx-1
320            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 )
321           ENDDO           ENDDO
322          ENDDO          ENDDO
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22