/[MITgcm]/MITgcm/model/src/calc_gs.F
ViewVC logotype

Diff of /MITgcm/model/src/calc_gs.F

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

revision 1.20 by heimbach, Fri Jun 9 14:26:30 2000 UTC revision 1.21 by adcroft, Wed Jun 21 19:15:26 2000 UTC
# Line 6  CStartOfInterFace Line 6  CStartOfInterFace
6        SUBROUTINE CALC_GS(        SUBROUTINE CALC_GS(
7       I           bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,       I           bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,
8       I           xA,yA,uTrans,vTrans,rTrans,maskup,maskC,       I           xA,yA,uTrans,vTrans,rTrans,maskup,maskC,
9       I           K13,K23,KappaRS,KapGM,       I           KappaRS,
10       U           af,df,fZon,fMer,fVerS,       U           af,df,fZon,fMer,fVerS,
11       I           myCurrentTime, myThid )       I           myCurrentTime, myThid )
12  C     /==========================================================\  C     /==========================================================\
# Line 43  C     == GLobal variables == Line 43  C     == GLobal variables ==
43  #include "PARAMS.h"  #include "PARAMS.h"
44  #include "GRID.h"  #include "GRID.h"
45  #include "FFIELDS.h"  #include "FFIELDS.h"
 #ifdef ALLOW_KPP  
 #include "KPPMIX.h"  
 #endif  
46    
47  C     == Routine arguments ==  C     == Routine arguments ==
48  C     fZon    - Work array for flux of temperature in the east-west  C     fZon    - Work array for flux of temperature in the east-west
# Line 76  C     myThid - Instance number for this Line 73  C     myThid - Instance number for this
73        _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
74        _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
75        _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
       _RL K13   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  
       _RL K23   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  
76        _RL KappaRS(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL KappaRS(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
       _RL KapGM (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
77        _RL af    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL af    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
78        _RL df    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL df    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
79        INTEGER k,kUp,kDown,kM1        INTEGER k,kUp,kDown,kM1
# Line 159  C     Advective component of zonal flux Line 153  C     Advective component of zonal flux
153  C     o Diffusive component of zonal flux  C     o Diffusive component of zonal flux
154        DO j=jMin,jMax        DO j=jMin,jMax
155         DO i=iMin,iMax         DO i=iMin,iMax
156          df(i,j) = -(diffKhS+0.5*(KapGM(i,j)+KapGM(i-1,j)))*          df(i,j) = -diffKhS*xA(i,j)*dSdx(i,j)
      &            xA(i,j)*dSdx(i,j)  
157         ENDDO         ENDDO
158        ENDDO        ENDDO
159    #ifdef ALLOW_GMREDI
160          IF (use_GMRedi) CALL GMREDI_XTRANSPORT(
161         I     iMin,iMax,jMin,jMax,bi,bj,K,
162         I     xA,salt,
163         U     df,
164         I     myThid)
165    #endif
166  C     o Add the bi-harmonic contribution  C     o Add the bi-harmonic contribution
167        IF (diffK4S .NE. 0.) THEN        IF (diffK4S .NE. 0.) THEN
168         DO j=jMin,jMax         DO j=jMin,jMax
# Line 191  C       Advective component of meridiona Line 191  C       Advective component of meridiona
191  C     Diffusive component of meridional flux  C     Diffusive component of meridional flux
192        DO j=jMin,jMax        DO j=jMin,jMax
193         DO i=iMin,iMax         DO i=iMin,iMax
194          df(i,j) = -(diffKhS+0.5*(KapGM(i,j)+KapGM(i,j-1)))*          df(i,j) = -diffKhS*yA(i,j)*dSdy(i,j)
      &            yA(i,j)*dSdy(i,j)  
195         ENDDO         ENDDO
196        ENDDO        ENDDO
197    #ifdef ALLOW_GMREDI
198          IF (use_GMRedi) CALL GMREDI_YTRANSPORT(
199         I     iMin,iMax,jMin,jMax,bi,bj,K,
200         I     yA,salt,
201         U     df,
202         I     myThid)
203    #endif
204  C     o Add the bi-harmonic contribution  C     o Add the bi-harmonic contribution
205        IF (diffK4S .NE. 0.) THEN        IF (diffK4S .NE. 0.) THEN
206         DO j=jMin,jMax         DO j=jMin,jMax
# Line 212  C     Net meridional flux Line 218  C     Net meridional flux
218         ENDDO         ENDDO
219        ENDDO        ENDDO
220    
 C--   Interpolate terms for Redi/GM scheme  
       DO j=jMin,jMax  
        DO i=iMin,iMax  
         dSdx(i,j) = 0.5*(  
      &   +0.5*(_maskW(i+1,j,k,bi,bj)  
      &         *_recip_dxC(i+1,j,bi,bj)*  
      &           (salt(i+1,j,k,bi,bj)-salt(i,j,k,bi,bj))  
      &        +_maskW(i,j,k,bi,bj)  
      &         *_recip_dxC(i,j,bi,bj)*  
      &           (salt(i,j,k,bi,bj)-salt(i-1,j,k,bi,bj)))  
      &   +0.5*(_maskW(i+1,j,km1,bi,bj)  
      &         *_recip_dxC(i+1,j,bi,bj)*  
      &           (salt(i+1,j,km1,bi,bj)-salt(i,j,km1,bi,bj))  
      &        +_maskW(i,j,km1,bi,bj)  
      &         *_recip_dxC(i,j,bi,bj)*  
      &           (salt(i,j,km1,bi,bj)-salt(i-1,j,km1,bi,bj)))  
      &       )  
        ENDDO  
       ENDDO  
       DO j=jMin,jMax  
        DO i=iMin,iMax  
         dSdy(i,j) = 0.5*(  
      &   +0.5*(_maskS(i,j,k,bi,bj)  
      &         *_recip_dyC(i,j,bi,bj)*  
      &           (salt(i,j,k,bi,bj)-salt(i,j-1,k,bi,bj))  
      &        +_maskS(i,j+1,k,bi,bj)  
      &         *_recip_dyC(i,j+1,bi,bj)*  
      &           (salt(i,j+1,k,bi,bj)-salt(i,j,k,bi,bj)))  
      &   +0.5*(_maskS(i,j,km1,bi,bj)  
      &         *_recip_dyC(i,j,bi,bj)*  
      &           (salt(i,j,km1,bi,bj)-salt(i,j-1,km1,bi,bj))  
      &        +_maskS(i,j+1,km1,bi,bj)  
      &         *_recip_dyC(i,j+1,bi,bj)*  
      &           (salt(i,j+1,km1,bi,bj)-salt(i,j,km1,bi,bj)))  
      &       )  
        ENDDO  
       ENDDO  
   
221  C--   Vertical flux (fVerS) above  C--   Vertical flux (fVerS) above
222  C     Advective component of vertical flux  C     Advective component of vertical flux
223  C     Note: For K=1 then KM1=1 this gives a barZ(T) = T  C     Note: For K=1 then KM1=1 this gives a barZ(T) = T
# Line 260  C     (this plays the role of the free-s Line 228  C     (this plays the role of the free-s
228       &   rTrans(i,j)*(salt(i,j,k,bi,bj)+salt(i,j,kM1,bi,bj))*0.5 _d 0       &   rTrans(i,j)*(salt(i,j,k,bi,bj)+salt(i,j,kM1,bi,bj))*0.5 _d 0
229         ENDDO         ENDDO
230        ENDDO        ENDDO
231  C     Diffusive component of vertical flux  C     o Diffusive component of vertical flux
232  C     Note: For K=1 then KM1=1 this gives a dS/dz = 0 upper  C     Note: For K=1 then KM1=1 and this gives a dS/dr = 0 upper
233  C           boundary condition.  C           boundary condition.
234        DO j=jMin,jMax        IF (implicitDiffusion) THEN
235         DO i=iMin,iMax         DO j=jMin,jMax
236          df(i,j) = _rA(i,j,bi,bj)*(          DO i=iMin,iMax
237       &   -KapGM(i,j)*K13(i,j,k)*dSdx(i,j)           df(i,j) = 0.
238       &   -KapGM(i,j)*K23(i,j,k)*dSdy(i,j)          ENDDO
      &   )  
239         ENDDO         ENDDO
240        ENDDO        ELSE
       IF (.NOT.implicitDiffusion) THEN  
241         DO j=jMin,jMax         DO j=jMin,jMax
242          DO i=iMin,iMax          DO i=iMin,iMax
243           df(i,j) = df(i,j) + _rA(i,j,bi,bj)*(           df(i,j) = - _rA(i,j,bi,bj)*(
244       &    -KappaRS(i,j,k)*recip_drC(k)       &    KappaRS(i,j,k)*recip_drC(k)
245       &    *(salt(i,j,kM1,bi,bj)-salt(i,j,k,bi,bj))*rkFac       &    *(salt(i,j,kM1,bi,bj)-salt(i,j,k,bi,bj))*rkFac
246       &    )       &    )
247          ENDDO          ENDDO
248         ENDDO         ENDDO
249        ENDIF        ENDIF
250    
251    #ifdef ALLOW_GMREDI
252          IF (use_GMRedi) CALL GMREDI_RTRANSPORT(
253         I     iMin,iMax,jMin,jMax,bi,bj,K,
254         I     maskUp,salt,
255         U     df,
256         I     myThid)
257    #endif
258    
259  #ifdef ALLOW_KPP  #ifdef ALLOW_KPP
260        IF (usingKPPmixing) THEN  C--   Add non-local KPP transport term (ghat) to diffusive salt flux.
261  C--   Add non local transport coefficient (ghat term) to right-hand-side        IF (use_KPPmixing) CALL KPP_TRANSPORT_S(
262  C     The nonlocal transport term is noNrero only for scalars in unstable       I     iMin,iMax,jMin,jMax,bi,bj,k,km1,
263  C     (convective) forcing conditions.       I     maskC,KappaRS,
264         IF ( TOP_LAYER ) THEN       U     df )
265          DO j=jMin,jMax  #endif
          DO i=iMin,iMax  
           df(i,j) = df(i,j) - _rA(i,j,bi,bj) *  
      &              EmPmR(i,j,bi,bj) * delZ(1) *  
      &              ( KappaRS(i,j,k)   * KPPghat(i,j,k,bi,bj)   )  
          ENDDO  
         ENDDO  
        ELSE  
         DO j=jMin,jMax  
          DO i=iMin,iMax  
           df(i,j) = df(i,j) - _rA(i,j,bi,bj) *  
      &              EmPmR(i,j,bi,bj) * delZ(1) *  
      &              ( KappaRS(i,j,k)   * KPPghat(i,j,k,bi,bj)  
      &              - KappaRS(i,j,k-1) * KPPghat(i,j,k-1,bi,bj) )  
          ENDDO  
         ENDDO  
        ENDIF  
       ENDIF  
 #endif /* ALLOW_KPP */  
266    
267  C     Net vertical flux  C     Net vertical flux
268        DO j=jMin,jMax        DO j=jMin,jMax
Legend:
Removed from v.1.20  
changed lines
  Added in v.1.21
  ViewVC Help
Powered by ViewVC 1.1.22