/[MITgcm]/MITgcm/pkg/gmredi/gmredi_calc_psi_b.F
ViewVC logotype

Diff of /MITgcm/pkg/gmredi/gmredi_calc_psi_b.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.2 by heimbach, Thu Nov 14 22:43:49 2002 UTC revision 1.10 by gforget, Fri May 30 02:50:16 2008 UTC
# Line 7  CStartOfInterface Line 7  CStartOfInterface
7        SUBROUTINE GMREDI_CALC_PSI_B(        SUBROUTINE GMREDI_CALC_PSI_B(
8       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
9       I             sigmaX, sigmaY, sigmaR,       I             sigmaX, sigmaY, sigmaR,
10         I             ldd97_LrhoW, ldd97_LrhoS,
11       I             myThid )       I             myThid )
12  C     /==========================================================\  C     /==========================================================\
13  C     | SUBROUTINE GMREDI_CALC_PSI_B                             |  C     | SUBROUTINE GMREDI_CALC_PSI_B                             |
# Line 22  C     == Global variables == Line 23  C     == Global variables ==
23  #include "EEPARAMS.h"  #include "EEPARAMS.h"
24  #include "PARAMS.h"  #include "PARAMS.h"
25  #include "GMREDI.h"  #include "GMREDI.h"
26  #include "GMREDI_DIAGS.h"  #include "FFIELDS.h"
27    
28  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
29  #include "tamc.h"  #include "tamc.h"
# Line 34  C Line 35  C
35        _RL sigmaX(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL sigmaX(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
36        _RL sigmaY(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL sigmaY(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
37        _RL sigmaR(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL sigmaR(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
38          _RL ldd97_LrhoW(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
39          _RL ldd97_LrhoS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
40        INTEGER bi,bj,iMin,iMax,jMin,jMax        INTEGER bi,bj,iMin,iMax,jMin,jMax
41        INTEGER myThid        INTEGER myThid
42  CEndOfInterface  CEndOfInterface
# Line 60  C-    Initialization : <= done in S/R gm Line 63  C-    Initialization : <= done in S/R gm
63            act3 = myThid - 1            act3 = myThid - 1
64            max3 = nTx*nTy            max3 = nTx*nTy
65            act4 = ikey_dynamics - 1            act4 = ikey_dynamics - 1
66            ikey = (act1 + 1) + act2*max1            igmkey = (act1 + 1) + act2*max1
67       &                      + act3*max1*max2       &                        + act3*max1*max2
68       &                      + act4*max1*max2*max3       &                        + act4*max1*max2*max3
69  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
70    
71    #ifdef ALLOW_AUTODIFF_TAMC
72    # ifdef GM_VISBECK_VARIABLE_K
73    CADJ STORE VisbeckK(:,:,bi,bj) = comlev1_bibj, key=igmkey, byte=isbyte
74    # endif
75    #endif
76        IF (GM_AdvForm) THEN        IF (GM_AdvForm) THEN
77         DO k=2,Nr         DO k=2,Nr
78         km1 = k-1         km1 = k-1
79    
80  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
81         kkey = (ikey-1)*Nr + k         kkey = (igmkey-1)*Nr + k
82         DO j=1-Oly,sNy+Oly         DO j=1-Oly,sNy+Oly
83          DO i=1-Olx,sNx+Olx          DO i=1-Olx,sNx+Olx
84           SlopeX(i,j)       = 0. _d 0           SlopeX(i,j)       = 0. _d 0
# Line 81  C-    Initialization : <= done in S/R gm Line 89  C-    Initialization : <= done in S/R gm
89         ENDDO         ENDDO
90  #endif  #endif
91    
       DO j=1-Oly+1,sNy+Oly-1  
        DO i=1-Olx+1,sNx+Olx-1  
   
92  C      Gradient of Sigma below U and V points  C      Gradient of Sigma below U and V points
93          SlopeX(i,j)=0.5*( sigmaX(i,j,km1)+sigmaX(i,j,k) )         DO j=1-Oly,sNy+Oly
94       &                 *maskW(i,j,k,bi,bj)          DO i=1-Olx+1,sNx+Olx
95          dSigmaDrW(i,j)=0.5*( sigmaR(i-1,j,k)+sigmaR(i,j,k) )           SlopeX(i,j)=op5*( sigmaX(i,j,km1)+sigmaX(i,j,k) )
96       &                 *maskW(i,j,k,bi,bj)       &                  *maskW(i,j,k,bi,bj)
97          SlopeY(i,j)=0.5*( sigmaY(i,j,km1)+sigmaY(i,j,k) )           dSigmaDrW(i,j)=op5*( sigmaR(i-1,j,k)+sigmaR(i,j,k) )
98       &                 *maskS(i,j,k,bi,bj)       &                  *maskW(i,j,k,bi,bj)
99          dSigmaDrS(i,j)=0.5*( sigmaR(i,j-1,k)+sigmaR(i,j,k) )          ENDDO
100       &                 *maskS(i,j,k,bi,bj)         ENDDO
101           DO j=1-Oly+1,sNy+Oly
102         ENDDO          DO i=1-Olx,sNx+Olx
103        ENDDO           SlopeY(i,j)=op5*( sigmaY(i,j,km1)+sigmaY(i,j,k) )
104         &                  *maskS(i,j,k,bi,bj)
105  C     Calculate slopes , taper and/or clip           dSigmaDrS(i,j)=op5*( sigmaR(i,j-1,k)+sigmaR(i,j,k) )
106        CALL GMREDI_SLOPE_PSI_B(       &                  *maskS(i,j,k,bi,bj)
107       I             dSigmaDrW, dSigmaDrS,          ENDDO
108       I             rF(K),K,         ENDDO
109       U             SlopeX, SlopeY,  
110    C      Calculate slopes , taper and/or clip
111           CALL GMREDI_SLOPE_PSI(
112       O             taperX, taperY,       O             taperX, taperY,
113         U             SlopeX, SlopeY,
114         U             dSigmaDrW, dSigmaDrS,
115         I             ldd97_LrhoW, ldd97_LrhoS, rF(k), k,
116       I             bi, bj, myThid )       I             bi, bj, myThid )
117    
118  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 112  CADJ STORE taperX(:,:)       = comlev1_b Line 122  CADJ STORE taperX(:,:)       = comlev1_b
122  CADJ STORE taperY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE taperY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
123  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
124    
       DO j=1-Oly+1,sNy+Oly-1  
        DO i=1-Olx+1,sNx+Olx-1  
   
125  C-  Compute the 2 stream-function Components ( GM bolus vel.)  C-  Compute the 2 stream-function Components ( GM bolus vel.)
126          GM_PsiX(i,j,k,bi,bj) = SlopeX(i,j)*taperX(i,j)         DO j=1-Oly,sNy+Oly
127       &   *( GM_background_K          DO i=1-Olx+1,sNx+Olx
128              GM_PsiX(i,j,k,bi,bj) = SlopeX(i,j)*taperX(i,j)
129    #if (defined (ALLOW_AUTODIFF) && defined (ALLOW_KAPGM_CONTROL))
130         &     *( kapgm(i,j,k,bi,bj)
131    #else
132         &     *( GM_background_K
133    #endif
134  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
135       &    +0.5*(VisbeckK(i-1,j,bi,bj)+VisbeckK(i,j,bi,bj))       &      +op5*(VisbeckK(i-1,j,bi,bj)+VisbeckK(i,j,bi,bj))
136    #endif
137         &      )*maskW(i,j,k,bi,bj)
138    #ifdef ALLOW_EDDYPSI
139         &     +eddyPsiX(i,j,k,bi,bj)*maskW(i,j,k,bi,bj)
140    #endif
141            ENDDO
142           ENDDO
143           DO j=1-Oly+1,sNy+Oly
144            DO i=1-Olx,sNx+Olx
145             GM_PsiY(i,j,k,bi,bj) = SlopeY(i,j)*taperY(i,j)
146    #if (defined (ALLOW_AUTODIFF) && defined (ALLOW_KAPGM_CONTROL))
147         &     *( kapgm(i,j,k,bi,bj)
148    #else
149         &     *( GM_background_K
150  #endif  #endif
      &    )*maskW(i,j,k,bi,bj)  
         GM_PsiY(i,j,k,bi,bj) = SlopeY(i,j)*taperY(i,j)  
      &   *( GM_background_K  
151  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
152       &    +0.5*(VisbeckK(i,j-1,bi,bj)+VisbeckK(i,j,bi,bj))       &      +op5*(VisbeckK(i,j-1,bi,bj)+VisbeckK(i,j,bi,bj))
153  #endif  #endif
154       &    )*maskS(i,j,k,bi,bj)       &      )*maskS(i,j,k,bi,bj)
155    #ifdef ALLOW_EDDYPSI
156  #ifdef ALLOW_TIMEAVE       &     +eddyPsiY(i,j,k,bi,bj)*maskS(i,j,k,bi,bj)
157  C--     Time-average  #endif
158          GM_PsiXtave(i,j,k,bi,bj)=GM_PsiXtave(i,j,k,bi,bj)          ENDDO
      &                          +GM_PsiX(i,j,k,bi,bj)*deltaTclock  
         GM_PsiYtave(i,j,k,bi,bj)=GM_PsiYtave(i,j,k,bi,bj)  
      &                          +GM_PsiY(i,j,k,bi,bj)*deltaTclock  
 #endif /* ALLOW_TIMEAVE */  
   
159         ENDDO         ENDDO
       ENDDO  
160    
161  C-----  C----- end of loop on level k
162         ENDDO         ENDDO
163    
164        ENDIF        ENDIF
165  #endif /* GM_BOLUS_ADVEC */  #endif /* GM_BOLUS_ADVEC */
166  #endif /* ALLOW_GMREDI */  #endif /* ALLOW_GMREDI */
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22