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

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

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

revision 1.24 by heimbach, Fri Jun 9 02:45:04 2000 UTC revision 1.25 by adcroft, Wed Jun 21 19:15:33 2000 UTC
# Line 6  CStartOfInterFace Line 6  CStartOfInterFace
6        SUBROUTINE CALC_GT(        SUBROUTINE CALC_GT(
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,KappaRT,KapGM,       I           KappaRT,
10       U           af,df,fZon,fMer,fVerT,       U           af,df,fZon,fMer,fVerT,
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"
46  #ifdef ALLOW_KPP  c #include "GM_ARRAYS.h"
 #include "KPPMIX.h"  
 #endif  
47    
48    
49  C     == Routine arguments ==  C     == Routine arguments ==
# Line 77  C     myThid - Instance number for this Line 75  C     myThid - Instance number for this
75        _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
76        _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
77        _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)  
78        _RL KappaRT(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL KappaRT(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
       _RL KapGM (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
79        _RL af    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL af    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
80        _RL df    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL df    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
81        INTEGER k,kUp,kDown,kM1        INTEGER k,kUp,kDown,kM1
# Line 97  C     I, J, K - Loop counters Line 92  C     I, J, K - Loop counters
92        _RL dTdx(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL dTdx(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
93        _RL dTdy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL dTdy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
94        _RL df4   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL df4   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
 #ifdef ALLOW_KPP  
       _RS hbl  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)    ! used by KPP mixing scheme  
       _RS frac (1-OLx:sNx+OLx,1-OLy:sNy+OLy)    ! used by KPP mixing scheme  
       _RS negone                                ! used as argument to SWFRAC  
       integer jwtype                            ! index for Jerlov water type  
 #endif  
95    
96  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
97  C--   only the kUp part of fverT is set in this subroutine  C--   only the kUp part of fverT is set in this subroutine
# Line 169  C     o Advective component of zonal flu Line 158  C     o Advective component of zonal flu
158  C     o Diffusive component of zonal flux  C     o Diffusive component of zonal flux
159        DO j=jMin,jMax        DO j=jMin,jMax
160         DO i=iMin,iMax         DO i=iMin,iMax
161          df(i,j) = -(diffKhT+0.5*(KapGM(i,j)+KapGM(i-1,j)))*          df(i,j) = -diffKhT*xA(i,j)*dTdx(i,j)
      &            xA(i,j)*dTdx(i,j)  
162         ENDDO         ENDDO
163        ENDDO        ENDDO
164    #ifdef ALLOW_GMREDI
165          IF (use_GMRedi) CALL GMREDI_XTRANSPORT(
166         I     iMin,iMax,jMin,jMax,bi,bj,K,
167         I     xA,theta,
168         U     df,
169         I     myThid)
170    #endif
171  C     o Add the bi-harmonic contribution  C     o Add the bi-harmonic contribution
172        IF (diffK4T .NE. 0.) THEN        IF (diffK4T .NE. 0.) THEN
173         DO j=jMin,jMax         DO j=jMin,jMax
# Line 206  C     o Advective component of meridiona Line 201  C     o Advective component of meridiona
201  C     o Diffusive component of meridional flux  C     o Diffusive component of meridional flux
202        DO j=jMin,jMax        DO j=jMin,jMax
203         DO i=iMin,iMax         DO i=iMin,iMax
204          df(i,j) = -(diffKhT+0.5*(KapGM(i,j)+KapGM(i,j-1)))*          df(i,j) = -diffKhT*yA(i,j)*dTdy(i,j)
      &            yA(i,j)*dTdy(i,j)  
205         ENDDO         ENDDO
206        ENDDO        ENDDO
207    #ifdef ALLOW_GMREDI
208          IF (use_GMRedi) CALL GMREDI_YTRANSPORT(
209         I     iMin,iMax,jMin,jMax,bi,bj,K,
210         I     yA,theta,
211         U     df,
212         I     myThid)
213    #endif
214  C     o Add the bi-harmonic contribution  C     o Add the bi-harmonic contribution
215        IF (diffK4T .NE. 0.) THEN        IF (diffK4T .NE. 0.) THEN
216         DO j=jMin,jMax         DO j=jMin,jMax
# Line 285  C     (this plays the role of the free-s Line 286  C     (this plays the role of the free-s
286  C     o Diffusive component of vertical flux  C     o Diffusive component of vertical flux
287  C     Note: For K=1 then KM1=1 and this gives a dT/dr = 0 upper  C     Note: For K=1 then KM1=1 and this gives a dT/dr = 0 upper
288  C           boundary condition.  C           boundary condition.
289        DO j=jMin,jMax        IF (implicitDiffusion) THEN
290         DO i=iMin,iMax         DO j=jMin,jMax
291          df(i,j) = _rA(i,j,bi,bj)*(          DO i=iMin,iMax
292       &   -KapGM(i,j)*K13(i,j,k)*dTdx(i,j)           df(i,j) = 0.
293       &   -KapGM(i,j)*K23(i,j,k)*dTdy(i,j)          ENDDO
      &   )  
294         ENDDO         ENDDO
295        ENDDO        ELSE
       IF (.NOT.implicitDiffusion) THEN  
296         DO j=jMin,jMax         DO j=jMin,jMax
297          DO i=iMin,iMax          DO i=iMin,iMax
298           df(i,j) = df(i,j) + _rA(i,j,bi,bj)*(           df(i,j) = - _rA(i,j,bi,bj)*(
299       &    -KappaRT(i,j,k)*recip_drC(k)       &    KappaRT(i,j,k)*recip_drC(k)
300       &    *(theta(i,j,kM1,bi,bj)-theta(i,j,k,bi,bj))*rkFac       &    *(theta(i,j,kM1,bi,bj)-theta(i,j,k,bi,bj))*rkFac
301       &    )       &    )
302          ENDDO          ENDDO
# Line 305  C           boundary condition. Line 304  C           boundary condition.
304        ENDIF        ENDIF
305  #endif /* INCLUDE_T_DIFFUSION_CODE */  #endif /* INCLUDE_T_DIFFUSION_CODE */
306    
307    #ifdef ALLOW_GMREDI
308          IF (use_GMRedi) CALL GMREDI_RTRANSPORT(
309         I     iMin,iMax,jMin,jMax,bi,bj,K,
310         I     maskUp,theta,
311         U     df,
312         I     myThid)
313    #endif
314    
315  #ifdef ALLOW_KPP  #ifdef ALLOW_KPP
316        IF (usingKPPmixing) THEN  C--   Add non local KPP transport term (ghat) to diffusive T flux.
317  C--   Compute fraction of solar short-wave flux penetrating to        IF (use_KPPmixing) CALL KPP_TRANSPORT_T(
318  C     the bottom of the mixing layer       I     iMin,iMax,jMin,jMax,bi,bj,k,km1,
319         DO j=jMin,jMax       I     maskC,KappaRT,
320          DO i=iMin,iMax       U     df )
321           hbl(i,j) = KPPhbl(i,j,bi,bj)  #endif
         ENDDO  
        ENDDO  
        j=(sNx+2*OLx)*(sNy+2*OLy)  
        jwtype = 3  
        negone = -1.  
        CALL SWFRAC(  
      I     j, negone, hbl, jwtype,  
      O     frac )  
   
 C     Add non local transport coefficient (ghat term) to right-hand-side  
 C     The nonlocal transport term is noNrero only for scalars in unstable  
 C     (convective) forcing conditions.  
 C     Note: -[Qnet * delZ(1) + Qsw * (1-frac) / KPPhbl] * 4000 * rho  
 C     is the total heat flux  
 C     penetrating the mixed layer from the surface in (deg C / s)  
        IF ( TOP_LAYER ) THEN  
         DO j=jMin,jMax  
          DO i=iMin,iMax  
           df(i,j) = df(i,j) + _rA(i,j,bi,bj) *  
      &           ( Qnet(i,j,bi,bj) * delZ(1) +  
      &           Qsw(i,j,bi,bj) * (1.-frac(i,j))  
      &           / KPPhbl(i,j,bi,bj) ) *  
      &           ( KappaRT(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) *  
      &           ( Qnet(i,j,bi,bj) * delZ(1) +  
      &           Qsw(i,j,bi,bj)  * (1.-frac(i,j))  
      &           / KPPhbl(i,j,bi,bj) ) *  
      &           ( KappaRT(i,j,k)   * KPPghat(i,j,k,  bi,bj)  
      &           - KappaRT(i,j,k-1) * KPPghat(i,j,k-1,bi,bj) )  
          ENDDO  
         ENDDO  
        ENDIF  
       ENDIF  
 #endif /* ALLOW_KPP */  
322    
323  C     o Net vertical flux  C     o Net vertical flux
324        DO j=jMin,jMax        DO j=jMin,jMax
Legend:
Removed from v.1.24  
changed lines
  Added in v.1.25
  ViewVC Help
Powered by ViewVC 1.1.22