/[MITgcm]/MITgcm/pkg/mom_fluxform/mom_fluxform.F
ViewVC logotype

Diff of /MITgcm/pkg/mom_fluxform/mom_fluxform.F

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

revision 1.35 by heimbach, Wed May 3 23:35:11 2006 UTC revision 1.39 by jmc, Tue Dec 5 05:30:38 2006 UTC
# Line 31  CBOP Line 31  CBOP
31  C !ROUTINE: MOM_FLUXFORM  C !ROUTINE: MOM_FLUXFORM
32    
33  C !INTERFACE: ==========================================================  C !INTERFACE: ==========================================================
34        SUBROUTINE MOM_FLUXFORM(        SUBROUTINE MOM_FLUXFORM(
35       I        bi,bj,iMin,iMax,jMin,jMax,k,kUp,kDown,       I        bi,bj,iMin,iMax,jMin,jMax,k,kUp,kDown,
36       I        KappaRU, KappaRV,       I        KappaRU, KappaRV,
37       U        fVerU, fVerV,       U        fVerU, fVerV,
# Line 40  C !INTERFACE: ========================== Line 40  C !INTERFACE: ==========================
40    
41  C !DESCRIPTION:  C !DESCRIPTION:
42  C Calculates all the horizontal accelerations except for the implicit surface  C Calculates all the horizontal accelerations except for the implicit surface
43  C pressure gradient and implciit vertical viscosity.  C pressure gradient and implicit vertical viscosity.
44    
45  C !USES: ===============================================================  C !USES: ===============================================================
46  C     == Global variables ==  C     == Global variables ==
# Line 52  C     == Global variables == Line 52  C     == Global variables ==
52  #include "PARAMS.h"  #include "PARAMS.h"
53  #include "GRID.h"  #include "GRID.h"
54  #include "SURFACE.h"  #include "SURFACE.h"
55  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
56  # include "tamc.h"  # include "tamc.h"
57  # include "tamc_keys.h"  # include "tamc_keys.h"
58  # include "MOM_FLUXFORM.h"  # include "MOM_FLUXFORM.h"
# Line 98  C  fZon                 :: zonal fluxes Line 98  C  fZon                 :: zonal fluxes
98  C  fMer                 :: meridional fluxes  C  fMer                 :: meridional fluxes
99  C  fVrUp,fVrDw          :: vertical viscous fluxes at interface k-1 & k  C  fVrUp,fVrDw          :: vertical viscous fluxes at interface k-1 & k
100        INTEGER i,j        INTEGER i,j
101  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
102        INTEGER imomkey        INTEGER imomkey
103  #endif  #endif
104        _RL vF(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL vF(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
# Line 110  C  fVrUp,fVrDw          :: vertical visc Line 110  C  fVrUp,fVrDw          :: vertical visc
110        _RL fVrUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL fVrUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
111        _RL fVrDw(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL fVrDw(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
112  C     afFacMom     :: Tracer parameters for turning terms on and off.  C     afFacMom     :: Tracer parameters for turning terms on and off.
113  C     vfFacMom          C     vfFacMom
114  C     pfFacMom        afFacMom - Advective terms  C     pfFacMom        afFacMom - Advective terms
115  C     cfFacMom        vfFacMom - Eddy viscosity terms  C     cfFacMom        vfFacMom - Eddy viscosity terms
116  C     mtFacMom        pfFacMom - Pressure terms  C     mtFacMom        pfFacMom - Pressure terms
117  C                     cfFacMom - Coriolis terms  C                     cfFacMom - Coriolis terms
# Line 169  CEOP Line 169  CEOP
169            act3 = myThid - 1            act3 = myThid - 1
170            max3 = nTx*nTy            max3 = nTx*nTy
171            act4 = ikey_dynamics - 1            act4 = ikey_dynamics - 1
172            imomkey = (act0 + 1)            imomkey = (act0 + 1)
173       &                    + act1*max0       &                    + act1*max0
174       &                    + act2*max0*max1       &                    + act2*max0*max1
175       &                    + act3*max0*max1*max2       &                    + act3*max0*max1*max2
# Line 189  C     Initialise intermediate terms Line 189  C     Initialise intermediate terms
189          fVrDw(i,j)= 0.          fVrDw(i,j)= 0.
190          rTransU(i,j)= 0.          rTransU(i,j)= 0.
191          rTransV(i,j)= 0.          rTransV(i,j)= 0.
192    c       KE(i,j)     = 0.
193    c       hDiv(i,j)   = 0.
194            vort3(i,j)  = 0.
195          strain(i,j) = 0.          strain(i,j) = 0.
196          tension(i,j)= 0.          tension(i,j)= 0.
197          guDiss(i,j) = 0.          guDiss(i,j) = 0.
198          gvDiss(i,j) = 0.          gvDiss(i,j) = 0.
 #ifdef ALLOW_AUTODIFF_TAMC  
         vort3(i,j)   = 0. _d 0  
         strain(i,j)  = 0. _d 0  
         tension(i,j) = 0. _d 0  
 #endif  
199         ENDDO         ENDDO
200        ENDDO        ENDDO
201    
# Line 251  C---- Calculate common quantities used i Line 249  C---- Calculate common quantities used i
249  C     Calculate tracer cell face open areas  C     Calculate tracer cell face open areas
250        DO j=1-OLy,sNy+OLy        DO j=1-OLy,sNy+OLy
251         DO i=1-OLx,sNx+OLx         DO i=1-OLx,sNx+OLx
252          xA(i,j) = _dyG(i,j,bi,bj)          xA(i,j) = _dyG(i,j,bi,bj)*deepFacC(k)
253       &   *drF(k)*_hFacW(i,j,k,bi,bj)       &          *drF(k)*_hFacW(i,j,k,bi,bj)
254          yA(i,j) = _dxG(i,j,bi,bj)          yA(i,j) = _dxG(i,j,bi,bj)*deepFacC(k)
255       &   *drF(k)*_hFacS(i,j,k,bi,bj)       &          *drF(k)*_hFacS(i,j,k,bi,bj)
256         ENDDO         ENDDO
257        ENDDO        ENDDO
258    
# Line 267  C     Make local copies of horizontal fl Line 265  C     Make local copies of horizontal fl
265        ENDDO        ENDDO
266    
267  C     Calculate velocity field "volume transports" through tracer cell faces.  C     Calculate velocity field "volume transports" through tracer cell faces.
268    C     anelastic: transports are scaled by rhoFacC (~ mass transport)
269        DO j=1-OLy,sNy+OLy        DO j=1-OLy,sNy+OLy
270         DO i=1-OLx,sNx+OLx         DO i=1-OLx,sNx+OLx
271          uTrans(i,j) = uFld(i,j)*xA(i,j)          uTrans(i,j) = uFld(i,j)*xA(i,j)*rhoFacC(k)
272          vTrans(i,j) = vFld(i,j)*yA(i,j)          vTrans(i,j) = vFld(i,j)*yA(i,j)*rhoFacC(k)
273         ENDDO         ENDDO
274        ENDDO        ENDDO
275    
# Line 304  C---  First call (k=1): compute vertical Line 303  C---  First call (k=1): compute vertical
303  C-    Calculate vertical transports above U & V points (West & South face):  C-    Calculate vertical transports above U & V points (West & South face):
304    
305  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
306  CADJ STORE dwtransc(:,:,bi,bj) =  # ifdef NONLIN_FRSURF
307    #  ifndef DISABLE_RSTAR_CODE
308    CADJ STORE dwtransc(:,:,bi,bj) =
309  CADJ &     comlev1_bibj_k, key = imomkey, byte = isbyte  CADJ &     comlev1_bibj_k, key = imomkey, byte = isbyte
310  CADJ STORE dwtransu(:,:,bi,bj) =  CADJ STORE dwtransu(:,:,bi,bj) =
311  CADJ &     comlev1_bibj_k, key = imomkey, byte = isbyte  CADJ &     comlev1_bibj_k, key = imomkey, byte = isbyte
312  CADJ STORE dwtransv(:,:,bi,bj) =  CADJ STORE dwtransv(:,:,bi,bj) =
313  CADJ &     comlev1_bibj_k, key = imomkey, byte = isbyte  CADJ &     comlev1_bibj_k, key = imomkey, byte = isbyte
314    #  endif
315    # endif /* NONLIN_FRSURF */
316  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
317          CALL MOM_CALC_RTRANS( k, bi, bj,          CALL MOM_CALC_RTRANS( k, bi, bj,
318       O                        rTransU, rTransV,       O                        rTransU, rTransV,
# Line 372  C--   Tendency is minus divergence of th Line 375  C--   Tendency is minus divergence of th
375       &      ( 0.5 _d 0*(rA(i,j,bi,bj)+rA(i-1,j,bi,bj)) )       &      ( 0.5 _d 0*(rA(i,j,bi,bj)+rA(i-1,j,bi,bj)) )
376  #else  #else
377       &     -_recip_hFacW(i,j,k,bi,bj)*recip_drF(k)       &     -_recip_hFacW(i,j,k,bi,bj)*recip_drF(k)
378       &     *recip_rAw(i,j,bi,bj)       &     *recip_rAw(i,j,bi,bj)*recip_deepFac2C(k)*recip_rhoFacC(k)
379  #endif  #endif
380       &    *( ( fZon(i,j  )     - fZon(i-1,j) )*uDudxFac       &     *( ( fZon(i,j  )     - fZon(i-1,j) )*uDudxFac
381       &      +( fMer(i,j+1)     - fMer(i,  j) )*vDudyFac       &       +( fMer(i,j+1)     - fMer(i,  j) )*vDudyFac
382       &      +(fVerU(i,j,kDown) - fVerU(i,j,kUp))*rkSign*rVelDudrFac       &       +(fVerU(i,j,kDown) - fVerU(i,j,kUp))*rkSign*rVelDudrFac
383       &     )       &     )
384           ENDDO           ENDDO
385          ENDDO          ENDDO
# Line 428  C-    endif momAdvection. Line 431  C-    endif momAdvection.
431  C---  Calculate eddy fluxes (dissipation) between cells for zonal flow.  C---  Calculate eddy fluxes (dissipation) between cells for zonal flow.
432    
433  C     Bi-harmonic term del^2 U -> v4F  C     Bi-harmonic term del^2 U -> v4F
434          IF (biharmonic)          IF (biharmonic)
435       &  CALL MOM_U_DEL2U(bi,bj,k,uFld,hFacZ,v4f,myThid)       &  CALL MOM_U_DEL2U(bi,bj,k,uFld,hFacZ,v4f,myThid)
436    
437  C     Laplacian and bi-harmonic terms, Zonal  Fluxes -> fZon  C     Laplacian and bi-harmonic terms, Zonal  Fluxes -> fZon
# Line 446  C     Eddy component of vertical flux (i Line 449  C     Eddy component of vertical flux (i
449         ENDIF         ENDIF
450    
451  C--   Tendency is minus divergence of the fluxes  C--   Tendency is minus divergence of the fluxes
452    C     anelastic: hor.visc.fluxes are not scaled by rhoFac (by vert.visc.flx is)
453          DO j=jMin,jMax          DO j=jMin,jMax
454           DO i=iMin,iMax           DO i=iMin,iMax
455            guDiss(i,j) =            guDiss(i,j) =
# Line 454  C--   Tendency is minus divergence of th Line 458  C--   Tendency is minus divergence of th
458       &      ( 0.5 _d 0*(rA(i,j,bi,bj)+rA(i-1,j,bi,bj)) )       &      ( 0.5 _d 0*(rA(i,j,bi,bj)+rA(i-1,j,bi,bj)) )
459  #else  #else
460       &     -_recip_hFacW(i,j,k,bi,bj)*recip_drF(k)       &     -_recip_hFacW(i,j,k,bi,bj)*recip_drF(k)
461       &     *recip_rAw(i,j,bi,bj)       &     *recip_rAw(i,j,bi,bj)*recip_deepFac2C(k)
462  #endif  #endif
463       &    *( ( fZon(i,j  ) - fZon(i-1,j) )*AhDudxFac       &     *( ( fZon(i,j  ) - fZon(i-1,j) )*AhDudxFac
464       &      +( fMer(i,j+1) - fMer(i,  j) )*AhDudyFac       &       +( fMer(i,j+1) - fMer(i,  j) )*AhDudyFac
465       &      +( fVrDw(i,j)  - fVrUp(i,j) )*rkSign*ArDudrFac       &       +( fVrDw(i,j)  - fVrUp(i,j)  )*rkSign*ArDudrFac
466         &                                     *recip_rhoFacC(k)
467       &     )       &     )
468           ENDDO           ENDDO
469          ENDDO          ENDDO
# Line 472  C--   Tendency is minus divergence of th Line 477  C--   Tendency is minus divergence of th
477          ENDIF          ENDIF
478  #endif  #endif
479    
480  C-- No-slip and drag BCs appear as body forces in cell abutting topography  C-- No-slip and drag BCs appear as body forces in cell abutting topography
481          IF (no_slip_sides) THEN          IF (no_slip_sides) THEN
482  C-     No-slip BCs impose a drag at walls...  C-     No-slip BCs impose a drag at walls...
483           CALL MOM_U_SIDEDRAG(           CALL MOM_U_SIDEDRAG(
# Line 575  C--   Tendency is minus divergence of th Line 580  C--   Tendency is minus divergence of th
580       &      ( 0.5 _d 0*(_rA(i,j,bi,bj)+_rA(i,j-1,bi,bj)) )       &      ( 0.5 _d 0*(_rA(i,j,bi,bj)+_rA(i,j-1,bi,bj)) )
581  #else  #else
582       &     -_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)       &     -_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)
583       &      *recip_rAs(i,j,bi,bj)       &     *recip_rAs(i,j,bi,bj)*recip_deepFac2C(k)*recip_rhoFacC(k)
584  #endif  #endif
585       &    *( ( fZon(i+1,j)     - fZon(i,j  ) )*uDvdxFac       &     *( ( fZon(i+1,j)     - fZon(i,j  ) )*uDvdxFac
586       &      +( fMer(i,  j)     - fMer(i,j-1) )*vDvdyFac       &       +( fMer(i,  j)     - fMer(i,j-1) )*vDvdyFac
587       &      +(fVerV(i,j,kDown) - fVerV(i,j,kUp))*rkSign*rVelDvdrFac       &       +(fVerV(i,j,kDown) - fVerV(i,j,kUp))*rkSign*rVelDvdrFac
588       &     )       &     )
589           ENDDO           ENDDO
590          ENDDO          ENDDO
# Line 630  C-    endif momAdvection. Line 635  C-    endif momAdvection.
635        IF (momViscosity) THEN        IF (momViscosity) THEN
636  C---  Calculate eddy fluxes (dissipation) between cells for meridional flow.  C---  Calculate eddy fluxes (dissipation) between cells for meridional flow.
637  C     Bi-harmonic term del^2 V -> v4F  C     Bi-harmonic term del^2 V -> v4F
638          IF (biharmonic)          IF (biharmonic)
639       &  CALL MOM_V_DEL2V(bi,bj,k,vFld,hFacZ,v4f,myThid)       &  CALL MOM_V_DEL2V(bi,bj,k,vFld,hFacZ,v4f,myThid)
640    
641  C     Laplacian and bi-harmonic terms, Zonal  Fluxes -> fZon  C     Laplacian and bi-harmonic terms, Zonal  Fluxes -> fZon
# Line 648  C     Eddy component of vertical flux (i Line 653  C     Eddy component of vertical flux (i
653         ENDIF         ENDIF
654    
655  C--   Tendency is minus divergence of the fluxes + coriolis + pressure term  C--   Tendency is minus divergence of the fluxes + coriolis + pressure term
656    C     anelastic: hor.visc.fluxes are not scaled by rhoFac (by vert.visc.flx is)
657          DO j=jMin,jMax          DO j=jMin,jMax
658           DO i=iMin,iMax           DO i=iMin,iMax
659            gvDiss(i,j) =            gvDiss(i,j) =
# Line 656  C--   Tendency is minus divergence of th Line 662  C--   Tendency is minus divergence of th
662       &      ( 0.5 _d 0*(_rA(i,j,bi,bj)+_rA(i,j-1,bi,bj)) )       &      ( 0.5 _d 0*(_rA(i,j,bi,bj)+_rA(i,j-1,bi,bj)) )
663  #else  #else
664       &     -_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)       &     -_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)
665       &      *recip_rAs(i,j,bi,bj)       &      *recip_rAs(i,j,bi,bj)*recip_deepFac2C(k)
666  #endif  #endif
667       &    *( ( fZon(i+1,j)  - fZon(i,j  ) )*AhDvdxFac       &     *( ( fZon(i+1,j)  - fZon(i,j  ) )*AhDvdxFac
668       &      +( fMer(i,  j)  - fMer(i,j-1) )*AhDvdyFac       &       +( fMer(i,  j)  - fMer(i,j-1) )*AhDvdyFac
669       &      +( fVrDw(i,j)   - fVrUp(i,j) )*rkSign*ArDvdrFac       &       +( fVrDw(i,j)   - fVrUp(i,j) )*rkSign*ArDvdrFac
670         &                                     *recip_rhoFacC(k)
671       &     )       &     )
672           ENDDO           ENDDO
673          ENDDO          ENDDO
# Line 674  C--   Tendency is minus divergence of th Line 681  C--   Tendency is minus divergence of th
681          ENDIF          ENDIF
682  #endif  #endif
683    
684  C-- No-slip and drag BCs appear as body forces in cell abutting topography  C-- No-slip and drag BCs appear as body forces in cell abutting topography
685          IF (no_slip_sides) THEN          IF (no_slip_sides) THEN
686  C-     No-slip BCs impose a drag at walls...  C-     No-slip BCs impose a drag at walls...
687           CALL MOM_V_SIDEDRAG(           CALL MOM_V_SIDEDRAG(
# Line 780  c     ELSE Line 787  c     ELSE
787        ENDIF        ENDIF
788    
789  C--   3.D Coriolis term (horizontal momentum, Eastward component: -f'*w)  C--   3.D Coriolis term (horizontal momentum, Eastward component: -f'*w)
790        IF ( nonHydrostatic.OR.quasiHydrostatic ) THEN        IF ( use3dCoriolis ) THEN
791          CALL MOM_U_CORIOLIS_NH(bi,bj,k,wVel,cf,myThid)          CALL MOM_U_CORIOLIS_NH(bi,bj,k,wVel,cf,myThid)
792          DO j=jMin,jMax          DO j=jMin,jMax
793           DO i=iMin,iMax           DO i=iMin,iMax
Legend:
Removed from v.1.35  
changed lines
  Added in v.1.39
  ViewVC Help
Powered by ViewVC 1.1.22