pkg/generic_advdiff/gad_u3_adv_r.F

4a20c1c4ff Jean*0001 #include "GAD_OPTIONS.h"
                0002
71207ba845 Alis*0003 CBOP
                0004 C !ROUTINE: GAD_U3_ADV_R
                0005
                0006 C !INTERFACE: ==========================================================
e9de1d7682 Jean*0007       SUBROUTINE GAD_U3_ADV_R(
                0008      I           bi, bj, k,
4a20c1c4ff Jean*0009      I           rTrans,
                0010      I           tracer,
                0011      O           wT,
                0012      I           myThid )
                0013
71207ba845 Alis*0014 C !DESCRIPTION:
                0015 C Calculates the area integrated vertical flux due to advection of a tracer
                0016 C using upwind biased third-order interpolation (or the $\kappa=1/3$ scheme):
                0017 C \begin{equation*}
                0018 C F^r_{adv} = W \overline{ \theta  - \frac{1}{6} \delta_{kk} \theta }^k
                0019 C                 + \frac{1}{12} |W| \delta_{kkk} \theta
                0020 C \end{equation*}
5cf0b3ba18 Jean*0021 C Near boundaries, mask all the gradients ==> still 3rd O.
71207ba845 Alis*0022
                0023 C !USES: ===============================================================
                0024       IMPLICIT NONE
4a20c1c4ff Jean*0025 #include "SIZE.h"
                0026 #include "GRID.h"
                0027 #include "GAD.h"
                0028
71207ba845 Alis*0029 C !INPUT PARAMETERS: ===================================================
                0030 C  bi,bj                :: tile indices
                0031 C  k                    :: vertical level
                0032 C  rTrans               :: vertical volume transport
                0033 C  tracer               :: tracer field
                0034 C  myThid               :: thread number
4a20c1c4ff Jean*0035       INTEGER bi,bj,k
                0036       _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
e9de1d7682 Jean*0037       _RL tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
4a20c1c4ff Jean*0038       INTEGER myThid
                0039
71207ba845 Alis*0040 C !OUTPUT PARAMETERS: ==================================================
                0041 C  wT                   :: vertical advective flux
                0042       _RL wT    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0043
                0044 C !LOCAL VARIABLES: ====================================================
                0045 C  i,j                  :: loop indices
                0046 C  kp1                  :: =min( k+1 , Nr )
                0047 C  km1                  :: =max( k-1 , 1 )
                0048 C  km2                  :: =max( k-2 , 1 )
                0049 C  Rjm,Rj,Rjp           :: differences at i-1,i,i+1
                0050 C  Rjjm,Rjjp            :: second differences at i-1,i
4a20c1c4ff Jean*0051       INTEGER i,j,kp1,km1,km2
8a37624a25 Jean*0052       _RL Rjm,Rj,Rjp,Rjjm,Rjjp
71207ba845 Alis*0053 CEOP
4a20c1c4ff Jean*0054
                0055       km2=MAX(1,k-2)
                0056       km1=MAX(1,k-1)
                0057       kp1=MIN(Nr,k+1)
                0058
                0059       IF ( k.EQ.1 .OR. k.GT.Nr ) THEN
e9de1d7682 Jean*0060        DO j=1-OLy,sNy+OLy
                0061         DO i=1-OLx,sNx+OLx
4a20c1c4ff Jean*0062          wT(i,j) = 0.
                0063         ENDDO
                0064        ENDDO
                0065       ELSE
e9de1d7682 Jean*0066        DO j=1-OLy,sNy+OLy
                0067         DO i=1-OLx,sNx+OLx
                0068          Rjp = (tracer(i,j,kp1)-tracer(i,j, k ))*maskC(i,j,kp1,bi,bj)
                0069          Rj  = (tracer(i,j, k )-tracer(i,j,km1))
                0070          Rjm = (tracer(i,j,km1)-tracer(i,j,km2))*maskC(i,j,km2,bi,bj)
                0071          Rjjp = Rjp-Rj
                0072          Rjjm = Rj-Rjm
4a20c1c4ff Jean*0073          wT(i,j) = maskC(i,j,km1,bi,bj)*(
e9de1d7682 Jean*0074      &     rTrans(i,j)*( (tracer(i,j,k)+tracer(i,j,km1))*0.5 _d 0
                0075      &                  -oneSixth*(Rjjm+Rjjp)*0.5 _d 0  )
4a20c1c4ff Jean*0076      &    +ABS(rTrans(i,j))*
e9de1d7682 Jean*0077      &                   oneSixth*(Rjjm-Rjjp)*0.5 _d 0
4a20c1c4ff Jean*0078      &                                  )
                0079         ENDDO
                0080        ENDDO
                0081       ENDIF
                0082
                0083       RETURN
                0084       END