model/src/calc_adv_flow.F

d818e7de60 Jean*0001 #include "PACKAGES_CONFIG.h"
8942316762 Jean*0002 #include "CPP_OPTIONS.h"
                0003
                0004 CBOP
                0005 C     !ROUTINE: CALC_ADV_FLOW
                0006 C     !INTERFACE:
                0007       SUBROUTINE CALC_ADV_FLOW(
                0008      I                uFld, vFld, wFld,
                0009      U                rTrans,
                0010      O                uTrans, vTrans, rTransKp,
                0011      O                maskUp, xA, yA,
                0012      I                k, bi, bj, myThid )
                0013 C     !DESCRIPTION: \bv
                0014 C     *==========================================================*
                0015 C     | SUBROUTINE CALC_ADV_FLOW
                0016 C     | o Calculate common data (such as volume flux) for use
                0017 C     |   by "Right hand side" subroutines.
                0018 C     *==========================================================*
                0019 C     | Here, we calculate terms or spatially varying factors
                0020 C     | that are used at various points in the "RHS" subroutines.
                0021 C     | This reduces the amount of total work, total memory
                0022 C     | and therefore execution time and is generally a good
                0023 C     | idea.
                0024 C     *==========================================================*
                0025 C     \ev
                0026
                0027 C     !USES:
                0028       IMPLICIT NONE
                0029 C     == GLobal variables ==
                0030 #include "SIZE.h"
                0031 #include "EEPARAMS.h"
                0032 #include "PARAMS.h"
                0033 #include "GRID.h"
                0034
                0035 C     !INPUT/OUTPUT PARAMETERS:
                0036 C     == Routine arguments ==
                0037 C     uFld     :: 3-D local copy of horizontal velocity, zonal  component
                0038 C     vFld     :: 3-D local copy of horizontal velocity, merid. component
                0039 C     wFld     :: 3-D local copy of vertical velocity
                0040 C     rTrans   :: Vertical volume transport through interface k
                0041 C     uTrans   :: Zonal volume transport through cell face
                0042 C     vTrans   :: Meridional volume transport through cell face
                0043 C     rTransKp :: Vertical volume transport through interface k+1
                0044 C     maskUp   :: Land/water mask for Wvel points (interface k)
                0045 C     xA       :: Tracer cell face area normal to X
                0046 C     yA       :: Tracer cell face area normal to X
                0047 C     k,bi,bj  :: vertical & tile indices for this calculation
                0048 C     myThid   :: my Thread Id. number
                0049
                0050       _RL uFld  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0051       _RL vFld  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0052       _RL wFld  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0053       _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0054       _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0055       _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0056       _RL rTransKp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0057       _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0058       _RS xA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0059       _RS yA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0060       INTEGER k,bi,bj
                0061       INTEGER myThid
                0062
                0063 C     !LOCAL VARIABLES:
                0064 C     == Local variables ==
                0065 C     i, j :: Loop counters
                0066       INTEGER i,j
                0067 CEOP
                0068
                0069 C--   Calculate tracer cell face open areas
                0070       DO j=1-OLy,sNy+OLy
                0071        DO i=1-OLx,sNx+OLx
                0072          xA(i,j) = _dyG(i,j,bi,bj)*deepFacC(k)
                0073      &           *drF(k)*_hFacW(i,j,k,bi,bj)
                0074          yA(i,j) = _dxG(i,j,bi,bj)*deepFacC(k)
                0075      &           *drF(k)*_hFacS(i,j,k,bi,bj)
                0076        ENDDO
                0077       ENDDO
                0078
                0079 C--   copy previous rTrans (input) to output array rTransKp
                0080       IF ( k.EQ.Nr ) THEN
                0081         DO j=1-OLy,sNy+OLy
                0082          DO i=1-OLx,sNx+OLx
                0083           rTransKp(i,j) = 0. _d 0
                0084          ENDDO
                0085         ENDDO
                0086       ELSE
                0087         DO j=1-OLy,sNy+OLy
                0088          DO i=1-OLx,sNx+OLx
d818e7de60 Jean*0089 #ifdef ALLOW_AUTODIFF
                0090 C-    Re-compute vertical transport: this changes "rTrans" to be
                0091 C     an output only argument and therefore simplifies dependencies
                0092           rTransKp(i,j) = wFld(i,j,k+1)*rA(i,j,bi,bj)
                0093      &                  * maskC(i,j,k,bi,bj)*maskC(i,j,k+1,bi,bj)
                0094      &                  * deepFac2F(k+1)*rhoFacF(k+1)
                0095 #else /* ALLOW_AUTODIFF */
                0096 C-    Copy rTrans value from previous call (i.e., k+1):
8942316762 Jean*0097           rTransKp(i,j) = rTrans(i,j)
d818e7de60 Jean*0098 #endif /* ALLOW_AUTODIFF */
8942316762 Jean*0099          ENDDO
                0100         ENDDO
                0101       ENDIF
                0102
                0103 C--   Calculate "volume transports" through tracer cell faces.
                0104 C     anelastic: scaled by rhoFacC (~ mass transport)
                0105       DO j=1-OLy,sNy+OLy
                0106        DO i=1-OLx,sNx+OLx
                0107          uTrans(i,j) = uFld(i,j,k)*xA(i,j)*rhoFacC(k)
                0108          vTrans(i,j) = vFld(i,j,k)*yA(i,j)*rhoFacC(k)
                0109        ENDDO
                0110       ENDDO
                0111
                0112 C--   Calculate vertical "volume transport" through tracer cell face
                0113       IF (k.EQ.1) THEN
                0114 C-      Surface interface :
                0115         DO j=1-OLy,sNy+OLy
                0116          DO i=1-OLx,sNx+OLx
                0117            maskUp(i,j) = 0. _d 0
                0118            rTrans(i,j) = 0. _d 0
                0119          ENDDO
                0120         ENDDO
                0121       ELSE
                0122 C-      Interior interface :
                0123 C       anelastic: rTrans is scaled by rhoFacF (~ mass transport)
                0124         DO j=1-OLy,sNy+OLy
                0125          DO i=1-OLx,sNx+OLx
                0126            maskUp(i,j) = maskC(i,j,k-1,bi,bj)*maskC(i,j,k,bi,bj)
                0127            rTrans(i,j) = wFld(i,j,k)*rA(i,j,bi,bj)*maskUp(i,j)
                0128      &                              *deepFac2F(k)*rhoFacF(k)
                0129          ENDDO
                0130         ENDDO
                0131       ENDIF
                0132
                0133       RETURN
                0134       END