model/src/integrate_for_w.F

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,
79b5d5775c Jean*0009      I                     myIter, 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
79b5d5775c Jean*0033 C     myIter     :: Current iteration number in simulation
                0034 C     myThid     :: my Thread Id. number
fb481a83c2 Alis*0035       INTEGER bi,bj,k
                0036       _RL  uFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0037       _RL  vFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
08a6f65fd0 Jean*0038 #ifdef ALLOW_ADDFLUID
d2a11ab670 Jean*0039       _RL  mFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
08a6f65fd0 Jean*0040 #else
                0041       _RL  mFld (1)
                0042 #endif
65de7f3d8d Jean*0043 #if (defined NONLIN_FRSURF) && !(defined DISABLE_RSTAR_CODE)
79b5d5775c Jean*0044       _RL rStarDhDt(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
65de7f3d8d Jean*0045 #else
                0046       _RL rStarDhDt(1)
                0047 #endif
fb481a83c2 Alis*0048       _RL  wFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
79b5d5775c Jean*0049       INTEGER myIter
fb481a83c2 Alis*0050       INTEGER myThid
                0051
9366854e02 Chri*0052 C     !LOCAL VARIABLES:
fb481a83c2 Alis*0053 C     == Local variables ==
9366854e02 Chri*0054 C     uTrans, vTrans :: Temps. for volume transports
d2a11ab670 Jean*0055 C     conv2d         :: horizontal transport convergence [m^3/s]
fb481a83c2 Alis*0056       INTEGER i,j
                0057       _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0058       _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
d2a11ab670 Jean*0059       _RL conv2d(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
9366854e02 Chri*0060 CEOP
fb481a83c2 Alis*0061
                0062 C--   Calculate velocity field "volume transports" through
4606c28752 Jean*0063 C     tracer cell faces (anelastic: scaled as a mass transport).
f9ff59e0c6 Jean*0064       DO j=1,sNy+1
                0065         DO i=1,sNx+1
4606c28752 Jean*0066           uTrans(i,j) = uFld(i,j,k,bi,bj)
                0067      &                *_dyG(i,j,bi,bj)*deepFacC(k)*rhoFacC(k)
                0068      &                *drF(k)*_hFacW(i,j,k,bi,bj)
                0069           vTrans(i,j) = vFld(i,j,k,bi,bj)
                0070      &                *_dxG(i,j,bi,bj)*deepFacC(k)*rhoFacC(k)
                0071      &                *drF(k)*_hFacS(i,j,k,bi,bj)
fb481a83c2 Alis*0072         ENDDO
                0073       ENDDO
d2a11ab670 Jean*0074       DO j=1,sNy
                0075         DO i=1,sNx
                0076           conv2d(i,j) = -( uTrans(i+1,j)-uTrans(i,j)
                0077      &                    +vTrans(i,j+1)-vTrans(i,j) )
                0078         ENDDO
                0079       ENDDO
                0080 #ifdef ALLOW_ADDFLUID
79b5d5775c Jean*0081       IF ( selectAddFluid.GE.1 .AND. myIter.NE.0 ) THEN
d2a11ab670 Jean*0082        DO j=1,sNy
                0083         DO i=1,sNx
                0084           conv2d(i,j) = conv2d(i,j)
                0085      &                + mFld(i,j,k,bi,bj)*mass2rUnit
                0086         ENDDO
                0087        ENDDO
                0088       ENDIF
                0089 #endif /* ALLOW_ADDFLUID */
fb481a83c2 Alis*0090
aea29c8517 Alis*0091 C--   Calculate vertical "volume transport" through face k
                0092 C     between tracer cell k-1 & k
                0093       IF (rigidLid) THEN
                0094 C-  o Rigid-Lid case: zero at lower and upper boundaries
4606c28752 Jean*0095         IF (k.EQ.1) THEN
f9ff59e0c6 Jean*0096           DO j=1,sNy
                0097            DO i=1,sNx
aea29c8517 Alis*0098              wFld(i,j,k,bi,bj) = 0.
                0099            ENDDO
fb481a83c2 Alis*0100           ENDDO
4606c28752 Jean*0101         ELSEIF (k.EQ.Nr) THEN
f9ff59e0c6 Jean*0102           DO j=1,sNy
                0103            DO i=1,sNx
4606c28752 Jean*0104              wFld(i,j,k,bi,bj) =
d2a11ab670 Jean*0105      &          conv2d(i,j)*recip_rA(i,j,bi,bj)
4606c28752 Jean*0106      &         *maskC(i,j,k,bi,bj)*maskC(i,j,k-1,bi,bj)
                0107      &         *recip_deepFac2F(k)*recip_rhoFacF(k)
aea29c8517 Alis*0108            ENDDO
fb481a83c2 Alis*0109           ENDDO
aea29c8517 Alis*0110         ELSE
f9ff59e0c6 Jean*0111           DO j=1,sNy
                0112            DO i=1,sNx
4606c28752 Jean*0113              wFld(i,j,k,bi,bj) =
                0114      &        ( wFld(i,j,k+1,bi,bj)*deepFac2F(k+1)*rhoFacF(k+1)
d2a11ab670 Jean*0115      &         +conv2d(i,j)*recip_rA(i,j,bi,bj)
4606c28752 Jean*0116      &        )*maskC(i,j,k,bi,bj)*maskC(i,j,k-1,bi,bj)
                0117      &         *recip_deepFac2F(k)*recip_rhoFacF(k)
aea29c8517 Alis*0118            ENDDO
                0119           ENDDO
                0120         ENDIF
00b29feb62 Jean*0121 #ifdef NONLIN_FRSURF
cdc9f269ae Patr*0122 # ifndef DISABLE_RSTAR_CODE
a2a20dcddc Jean*0123       ELSEIF ( select_rStar.NE.0 ) THEN
00b29feb62 Jean*0124 C-  o rStar case: zero under-ground and at r_lower boundary
4606c28752 Jean*0125 C     can be non-zero at surface (useRealFreshWaterFlux).
                0126         IF (k.EQ.Nr) THEN
00b29feb62 Jean*0127           DO j=1,sNy
                0128            DO i=1,sNx
4606c28752 Jean*0129              wFld(i,j,k,bi,bj) =
d2a11ab670 Jean*0130      &        ( conv2d(i,j)*recip_rA(i,j,bi,bj)
65de7f3d8d Jean*0131      &         -rStarDhDt(i,j)*drF(k)*h0FacC(i,j,k,bi,bj)
4606c28752 Jean*0132      &        )*maskC(i,j,k,bi,bj)
a58b14047e Jean*0133      &         *recip_deepFac2F(k)*recip_rhoFacF(k)
00b29feb62 Jean*0134            ENDDO
                0135           ENDDO
                0136         ELSE
                0137           DO j=1,sNy
                0138            DO i=1,sNx
4606c28752 Jean*0139              wFld(i,j,k,bi,bj) =
a58b14047e Jean*0140      &        ( wFld(i,j,k+1,bi,bj)*deepFac2F(k+1)*rhoFacF(k+1)
d2a11ab670 Jean*0141      &         +conv2d(i,j)*recip_rA(i,j,bi,bj)
65de7f3d8d Jean*0142      &         -rStarDhDt(i,j)*drF(k)*h0FacC(i,j,k,bi,bj)
4606c28752 Jean*0143      &        )*maskC(i,j,k,bi,bj)
a58b14047e Jean*0144      &         *recip_deepFac2F(k)*recip_rhoFacF(k)
00b29feb62 Jean*0145            ENDDO
                0146           ENDDO
                0147         ENDIF
cdc9f269ae Patr*0148 # endif /* DISABLE_RSTAR_CODE */
a2a20dcddc Jean*0149 # ifndef DISABLE_SIGMA_CODE
                0150       ELSEIF ( selectSigmaCoord.NE.0 ) THEN
                0151 C-  o Hybrid Sigma coordinate:
                0152         IF (k.EQ.Nr) THEN
                0153           DO j=1,sNy
                0154            DO i=1,sNx
                0155              wFld(i,j,k,bi,bj) =
                0156      &        ( conv2d(i,j)*recip_rA(i,j,bi,bj)
                0157      &         -dEtaHdt(i,j,bi,bj)*dBHybSigF(k)
                0158      &        )*maskC(i,j,k,bi,bj)
                0159            ENDDO
                0160           ENDDO
                0161         ELSE
                0162           DO j=1,sNy
                0163            DO i=1,sNx
                0164              wFld(i,j,k,bi,bj) =
                0165      &        ( wFld(i,j,k+1,bi,bj)
                0166      &         +conv2d(i,j)*recip_rA(i,j,bi,bj)
                0167      &         -dEtaHdt(i,j,bi,bj)*dBHybSigF(k)
                0168      &        )*maskC(i,j,k,bi,bj)
                0169            ENDDO
                0170           ENDDO
                0171         ENDIF
                0172 # endif /* DISABLE_SIGMA_CODE */
00b29feb62 Jean*0173 #endif /* NONLIN_FRSURF */
fb481a83c2 Alis*0174       ELSE
4606c28752 Jean*0175 C-  o Free Surface case (r-Coordinate):
aea29c8517 Alis*0176 C      non zero at surface ; zero under-ground and at r_lower boundary
4606c28752 Jean*0177         IF (k.EQ.Nr) THEN
f9ff59e0c6 Jean*0178           DO j=1,sNy
                0179            DO i=1,sNx
4606c28752 Jean*0180              wFld(i,j,k,bi,bj) =
d2a11ab670 Jean*0181      &          conv2d(i,j)*recip_rA(i,j,bi,bj)
4606c28752 Jean*0182      &         *maskC(i,j,k,bi,bj)
                0183      &         *recip_deepFac2F(k)*recip_rhoFacF(k)
aea29c8517 Alis*0184            ENDDO
fb481a83c2 Alis*0185           ENDDO
aea29c8517 Alis*0186         ELSE
f9ff59e0c6 Jean*0187           DO j=1,sNy
                0188            DO i=1,sNx
4606c28752 Jean*0189              wFld(i,j,k,bi,bj) =
                0190      &        ( wFld(i,j,k+1,bi,bj)*deepFac2F(k+1)*rhoFacF(k+1)
d2a11ab670 Jean*0191      &         +conv2d(i,j)*recip_rA(i,j,bi,bj)
4606c28752 Jean*0192      &        )*maskC(i,j,k,bi,bj)
                0193      &         *recip_deepFac2F(k)*recip_rhoFacF(k)
aea29c8517 Alis*0194            ENDDO
                0195           ENDDO
                0196         ENDIF
f9ff59e0c6 Jean*0197 C-  endif - rigid-lid / Free-Surf.
fb481a83c2 Alis*0198       ENDIF
                0199
                0200       RETURN
                0201       END