** Warning **

Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.

Last-Modified: Sat, 17 May 2024 05:11:26 GMT Content-Type: text/html; charset=utf-8 MITgcm/MITgcm/model/src/integrate_for_w.F
Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:36:56 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
fb481a83c2 Alis*0001 #include "CPP_OPTIONS.h"
                0002 
9366854e02 Chri*0003 CBOP
                0004 C     !ROUTINE: INTEGRATE_FOR_W
                0005 C     !INTERFACE:
4606c28752 Jean*0006       SUBROUTINE INTEGRATE_FOR_W(
65de7f3d8d Jean*0007      I                     bi, bj, k, uFld, vFld, mFld, rStarDhDt,
d2a11ab670 Jean*0008      O                     wFld,
                0009      I                     myThid )
fb481a83c2 Alis*0010 
9366854e02 Chri*0011 C     !DESCRIPTION: \bv
                0012 C     *==========================================================*
4606c28752 Jean*0013 C     | SUBROUTINE INTEGRATE_FOR_W
9366854e02 Chri*0014 C     | o Integrate for vertical velocity.
                0015 C     *==========================================================*
                0016 C     \ev
fb481a83c2 Alis*0017 
9366854e02 Chri*0018 C     !USES:
                0019       IMPLICIT NONE
fb481a83c2 Alis*0020 C     == GLobal variables ==
                0021 #include "SIZE.h"
                0022 #include "EEPARAMS.h"
                0023 #include "PARAMS.h"
                0024 #include "GRID.h"
00b29feb62 Jean*0025 #include "SURFACE.h"
fb481a83c2 Alis*0026 
9366854e02 Chri*0027 C     !INPUT/OUTPUT PARAMETERS:
fb481a83c2 Alis*0028 C     == Routine arguments ==
9366854e02 Chri*0029 C     uFld, vFld :: Zonal and meridional flow
d2a11ab670 Jean*0030 C     mFld       :: added mass
65de7f3d8d Jean*0031 C     rStarDhDt  :: relative time derivative of column thickness = d.eta/dt / H
9366854e02 Chri*0032 C     wFld       :: Vertical flow
fb481a83c2 Alis*0033       INTEGER bi,bj,k
                0034       _RL  uFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0035       _RL  vFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
08a6f65fd0 Jean*0036 #ifdef ALLOW_ADDFLUID
d2a11ab670 Jean*0037       _RL  mFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
08a6f65fd0 Jean*0038 #else
                0039       _RL  mFld (1)
                0040 #endif
65de7f3d8d Jean*0041 #if (defined NONLIN_FRSURF) && !(defined DISABLE_RSTAR_CODE)
                0042       _RL rStarDhDt(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
                0043 #else
                0044       _RL rStarDhDt(1)
                0045 #endif
fb481a83c2 Alis*0046       _RL  wFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0047       INTEGER myThid
                0048 
9366854e02 Chri*0049 C     !LOCAL VARIABLES:
fb481a83c2 Alis*0050 C     == Local variables ==
9366854e02 Chri*0051 C     uTrans, vTrans :: Temps. for volume transports
d2a11ab670 Jean*0052 C     conv2d         :: horizontal transport convergence [m^3/s]
fb481a83c2 Alis*0053       INTEGER i,j
                0054       _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0055       _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
d2a11ab670 Jean*0056       _RL conv2d(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
9366854e02 Chri*0057 CEOP
fb481a83c2 Alis*0058 
                0059 C--   Calculate velocity field "volume transports" through
4606c28752 Jean*0060 C     tracer cell faces (anelastic: scaled as a mass transport).
f9ff59e0c6 Jean*0061       DO j=1,sNy+1
                0062         DO i=1,sNx+1
4606c28752 Jean*0063           uTrans(i,j) = uFld(i,j,k,bi,bj)
                0064      &                *_dyG(i,j,bi,bj)*deepFacC(k)*rhoFacC(k)
                0065      &                *drF(k)*_hFacW(i,j,k,bi,bj)
                0066           vTrans(i,j) = vFld(i,j,k,bi,bj)
                0067      &                *_dxG(i,j,bi,bj)*deepFacC(k)*rhoFacC(k)
                0068      &                *drF(k)*_hFacS(i,j,k,bi,bj)
fb481a83c2 Alis*0069         ENDDO
                0070       ENDDO
d2a11ab670 Jean*0071       DO j=1,sNy
                0072         DO i=1,sNx
                0073           conv2d(i,j) = -( uTrans(i+1,j)-uTrans(i,j)
                0074      &                    +vTrans(i,j+1)-vTrans(i,j) )
                0075         ENDDO
                0076       ENDDO
                0077 #ifdef ALLOW_ADDFLUID
                0078       IF ( selectAddFluid.GE.1 ) THEN
                0079        DO j=1,sNy
                0080         DO i=1,sNx
                0081           conv2d(i,j) = conv2d(i,j)
                0082      &                + mFld(i,j,k,bi,bj)*mass2rUnit
                0083         ENDDO
                0084        ENDDO
                0085       ENDIF
                0086 #endif /* ALLOW_ADDFLUID */
fb481a83c2 Alis*0087 
aea29c8517 Alis*0088 C--   Calculate vertical "volume transport" through face k
                0089 C     between tracer cell k-1 & k
                0090       IF (rigidLid) THEN
                0091 C-  o Rigid-Lid case: zero at lower and upper boundaries
4606c28752 Jean*0092         IF (k.EQ.1) THEN
f9ff59e0c6 Jean*0093           DO j=1,sNy
                0094            DO i=1,sNx
aea29c8517 Alis*0095              wFld(i,j,k,bi,bj) = 0.
                0096            ENDDO
fb481a83c2 Alis*0097           ENDDO
4606c28752 Jean*0098         ELSEIF (k.EQ.Nr) THEN
f9ff59e0c6 Jean*0099           DO j=1,sNy
                0100            DO i=1,sNx
4606c28752 Jean*0101              wFld(i,j,k,bi,bj) =
d2a11ab670 Jean*0102      &          conv2d(i,j)*recip_rA(i,j,bi,bj)
4606c28752 Jean*0103      &         *maskC(i,j,k,bi,bj)*maskC(i,j,k-1,bi,bj)
                0104      &         *recip_deepFac2F(k)*recip_rhoFacF(k)
aea29c8517 Alis*0105            ENDDO
fb481a83c2 Alis*0106           ENDDO
aea29c8517 Alis*0107         ELSE
f9ff59e0c6 Jean*0108           DO j=1,sNy
                0109            DO i=1,sNx
4606c28752 Jean*0110              wFld(i,j,k,bi,bj) =
                0111      &        ( wFld(i,j,k+1,bi,bj)*deepFac2F(k+1)*rhoFacF(k+1)
d2a11ab670 Jean*0112      &         +conv2d(i,j)*recip_rA(i,j,bi,bj)
4606c28752 Jean*0113      &        )*maskC(i,j,k,bi,bj)*maskC(i,j,k-1,bi,bj)
                0114      &         *recip_deepFac2F(k)*recip_rhoFacF(k)
aea29c8517 Alis*0115            ENDDO
                0116           ENDDO
                0117         ENDIF
00b29feb62 Jean*0118 #ifdef NONLIN_FRSURF
cdc9f269ae Patr*0119 # ifndef DISABLE_RSTAR_CODE
a2a20dcddc Jean*0120       ELSEIF ( select_rStar.NE.0 ) THEN
00b29feb62 Jean*0121 C-  o rStar case: zero under-ground and at r_lower boundary
4606c28752 Jean*0122 C     can be non-zero at surface (useRealFreshWaterFlux).
                0123         IF (k.EQ.Nr) THEN
00b29feb62 Jean*0124           DO j=1,sNy
                0125            DO i=1,sNx
4606c28752 Jean*0126              wFld(i,j,k,bi,bj) =
d2a11ab670 Jean*0127      &        ( conv2d(i,j)*recip_rA(i,j,bi,bj)
65de7f3d8d Jean*0128      &         -rStarDhDt(i,j)*drF(k)*h0FacC(i,j,k,bi,bj)
4606c28752 Jean*0129      &        )*maskC(i,j,k,bi,bj)
a58b14047e Jean*0130      &         *recip_deepFac2F(k)*recip_rhoFacF(k)
00b29feb62 Jean*0131            ENDDO
                0132           ENDDO
                0133         ELSE
                0134           DO j=1,sNy
                0135            DO i=1,sNx
4606c28752 Jean*0136              wFld(i,j,k,bi,bj) =
a58b14047e Jean*0137      &        ( wFld(i,j,k+1,bi,bj)*deepFac2F(k+1)*rhoFacF(k+1)
d2a11ab670 Jean*0138      &         +conv2d(i,j)*recip_rA(i,j,bi,bj)
65de7f3d8d Jean*0139      &         -rStarDhDt(i,j)*drF(k)*h0FacC(i,j,k,bi,bj)
4606c28752 Jean*0140      &        )*maskC(i,j,k,bi,bj)
a58b14047e Jean*0141      &         *recip_deepFac2F(k)*recip_rhoFacF(k)
00b29feb62 Jean*0142            ENDDO
                0143           ENDDO
                0144         ENDIF
cdc9f269ae Patr*0145 # endif /* DISABLE_RSTAR_CODE */
a2a20dcddc Jean*0146 # ifndef DISABLE_SIGMA_CODE
                0147       ELSEIF ( selectSigmaCoord.NE.0 ) THEN
                0148 C-  o Hybrid Sigma coordinate:
                0149         IF (k.EQ.Nr) THEN
                0150           DO j=1,sNy
                0151            DO i=1,sNx
                0152              wFld(i,j,k,bi,bj) =
                0153      &        ( conv2d(i,j)*recip_rA(i,j,bi,bj)
                0154      &         -dEtaHdt(i,j,bi,bj)*dBHybSigF(k)
                0155      &        )*maskC(i,j,k,bi,bj)
                0156            ENDDO
                0157           ENDDO
                0158         ELSE
                0159           DO j=1,sNy
                0160            DO i=1,sNx
                0161              wFld(i,j,k,bi,bj) =
                0162      &        ( wFld(i,j,k+1,bi,bj)
                0163      &         +conv2d(i,j)*recip_rA(i,j,bi,bj)
                0164      &         -dEtaHdt(i,j,bi,bj)*dBHybSigF(k)
                0165      &        )*maskC(i,j,k,bi,bj)
                0166            ENDDO
                0167           ENDDO
                0168         ENDIF
                0169 # endif /* DISABLE_SIGMA_CODE */
00b29feb62 Jean*0170 #endif /* NONLIN_FRSURF */
fb481a83c2 Alis*0171       ELSE
4606c28752 Jean*0172 C-  o Free Surface case (r-Coordinate):
aea29c8517 Alis*0173 C      non zero at surface ; zero under-ground and at r_lower boundary
4606c28752 Jean*0174         IF (k.EQ.Nr) THEN
f9ff59e0c6 Jean*0175           DO j=1,sNy
                0176            DO i=1,sNx
4606c28752 Jean*0177              wFld(i,j,k,bi,bj) =
d2a11ab670 Jean*0178      &          conv2d(i,j)*recip_rA(i,j,bi,bj)
4606c28752 Jean*0179      &         *maskC(i,j,k,bi,bj)
                0180      &         *recip_deepFac2F(k)*recip_rhoFacF(k)
aea29c8517 Alis*0181            ENDDO
fb481a83c2 Alis*0182           ENDDO
aea29c8517 Alis*0183         ELSE
f9ff59e0c6 Jean*0184           DO j=1,sNy
                0185            DO i=1,sNx
4606c28752 Jean*0186              wFld(i,j,k,bi,bj) =
                0187      &        ( wFld(i,j,k+1,bi,bj)*deepFac2F(k+1)*rhoFacF(k+1)
d2a11ab670 Jean*0188      &         +conv2d(i,j)*recip_rA(i,j,bi,bj)
4606c28752 Jean*0189      &        )*maskC(i,j,k,bi,bj)
                0190      &         *recip_deepFac2F(k)*recip_rhoFacF(k)
aea29c8517 Alis*0191            ENDDO
                0192           ENDDO
                0193         ENDIF
f9ff59e0c6 Jean*0194 C-  endif - rigid-lid / Free-Surf.
fb481a83c2 Alis*0195       ENDIF
                0196 
                0197       RETURN
                0198       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!